unit heContnrs; { http://code.google.com/p/fprb/wiki/heContnrs }

{$mode objfpc}{$H+}

//------------------------------------------------------------------------------
// Copyright 2010, bflm. All rights reserved.
// Use of this source code is governed by a BSD-style
// license that can be found in the LICENSE file.
//------------------------------------------------------------------------------
// The list container is a FPC port/modification of source code from
// the Google Go project: http://code.google.com/p/go
//
// Copyright 2009 The Go Authors. All rights reserved.
// Use of this source code is governed by a BSD-style
// license that can be found in the LICENSE-GO file.
//------------------------------------------------------------------------------

{$if (FPC_VERSION < 2) or ((FPC_VERSION = 2) and (FPC_RELEASE < 6))}
{$fatal 'Requires FPC >= 2.6.0'}
{$endif}

interface

uses
  SysUtils;

type

  EMapKeyNotFound = class(Exception);

  { TheEnumerator }

  generic TheEnumerator<TIterator, TValue> = object
  public type
    TGetCurrent = function(var Iterator: TIterator): TValue of object;
    TMoveNext = function(var Iterator: TIterator): Boolean of object;
  private
    FGetCurrent: TGetCurrent;
    FIterator: TIterator;
    FMoveNext: TMoveNext;
    function GetCurrent: TValue;
  public
    procedure Init(const InitialIterator: TIterator; const Mover: TMoveNext; const Getter: TGetCurrent);
    function MoveNext: Boolean;
    property Current: TValue read GetCurrent;
  end;

  { TheEnumeratorProvider }

  generic TheEnumeratorProvider<TProvidedEnumerator> = object
  public
    FEnumerator: TProvidedEnumerator;
    function GetEnumerator: TProvidedEnumerator;
  end;

  { TheObjectVector }

  generic TheObjectVector<TItem> = class { http://code.google.com/p/fprb/wiki/TheObjectVector }
  public type
    PItem = ^TItem;
    TCompare = function(const A, B: TItem): Integer;
    TEnumerator = specialize TheEnumerator<Integer, TItem>;
    TEnumeratorProvider = specialize TheEnumeratorProvider<TEnumerator>;
  private
    FCapacity: Integer;
    FCount: Integer;
    FData: PItem;
    FOwnObjects: Boolean;
    function GetFirst: TItem;
    function GetItems(const Index: Integer): TItem;
    function GetCurrent(var Index: Integer): TItem;
    function GetLast: TItem;
    function MoveNext(var Index: Integer): Boolean;
    function MovePrev(var Index: Integer): Boolean;
    procedure SetCapacity(AValue: Integer);
    procedure SetItems(const Index: Integer; const AValue: TItem);
    procedure Sort(Left, Right: Integer; const Compare: TCompare);
  protected
    property Data: PItem read FData;
  public
    constructor Create(const AOwnObjects: Boolean = True);
    destructor Destroy; override;
    function Add(const Item: TItem): Integer;
    function Extract(const Index: Integer): TItem;
    function Find(const Item: TItem; out Index: Integer): Boolean;
    function GetEnumerator: TEnumerator;
    function Has(const Item: TItem): Boolean;
    function IndexOf(const Item: TItem): Integer;
    function Push(const Item: TItem): TItem;
    function Remove(const Item: TItem): Integer;
    function Reversed: TEnumeratorProvider;
    function SwapWith(const ItemAIndex: Integer; const ItemB: TItem): TItem;
    procedure Clear;
    procedure Delete(const Index: Integer);
    procedure Insert(const Index: Integer; const Item: TItem);
    procedure Kill;
    procedure Pack;
    procedure Sort(const Compare: TCompare);
    procedure Swap(const ItemAIndex, ItemBIndex: Integer);
    procedure Wipe;
    property Capacity: Integer read FCapacity write SetCapacity;
    property Count: Integer read FCount;
    property First: TItem read GetFirst;
    property Items[const Index: Integer]: TItem read GetItems write SetItems; default;
    property Last: TItem read GetLast;
    property OwnObjects: Boolean read FOwnObjects write FOwnObjects;
  end;

  { TheVector }

  generic TheVector<TItem> = class { http://code.google.com/p/fprb/wiki/TheVector }
  public type
    PItem = ^TItem;
    TEnumerator = specialize TheEnumerator<Integer, TItem>;
    TEnumeratorProvider = specialize TheEnumeratorProvider<TEnumerator>;
  private
    FCapacity: Integer;
    FCount: Integer;
    FData: PItem;
    function GetFirst: TItem;
    function GetItems(const Index: Integer): TItem;
    function GetCurrent(var Index: Integer): TItem;
    function GetLast: TItem;
    function MoveNext(var Index: Integer): Boolean;
    function MovePrev(var Index: Integer): Boolean;
    procedure SetCapacity(AValue: Integer);
    procedure SetItems(const Index: Integer; const AValue: TItem);
    procedure Sort(Left, Right: Integer);
  protected
    property Data: PItem read FData;
  public
    destructor Destroy; override;
    function Add(const Item: TItem): Integer;
    function Extract(const Index: Integer): TItem;
    function Find(const Item: TItem; out Index: Integer): Boolean;
    function GetEnumerator: TEnumerator;
    function Has(const Item: TItem): Boolean;
    function IndexOf(const Item: TItem): Integer;
    function Push(const Item: TItem): TItem;
    function Remove(const Item: TItem): Integer;
    function Reversed: TEnumeratorProvider;
    function SwapWith(const ItemAIndex: Integer; const ItemB: TItem): TItem;
    procedure Clear;
    procedure Delete(const Index: Integer);
    procedure Insert(const Index: Integer; const Item: TItem);
    procedure Pack;
    procedure Sort;
    procedure Swap(const ItemAIndex, ItemBIndex: Integer);
    property Capacity: Integer read FCapacity write SetCapacity;
    property Count: Integer read FCount;
    property First: TItem read GetFirst;
    property Items[const Index: Integer]: TItem read GetItems write SetItems; default;
    property Last: TItem read GetLast;
  end;

  { TheCmpVector }

  generic TheCmpVector<TItem> = class { http://code.google.com/p/fprb/wiki/TheCmpVector }
  public type
    PItem = ^TItem;
    TCompare = function(const A, B: TItem): Integer;
    TEnumerator = specialize TheEnumerator<Integer, TItem>;
    TEnumeratorProvider = specialize TheEnumeratorProvider<TEnumerator>;
  private
    FCapacity: Integer;
    FCount: Integer;
    FData: PItem;
    function GetFirst: TItem;
    function GetItems(const Index: Integer): TItem;
    function GetCurrent(var Index: Integer): TItem;
    function GetLast: TItem;
    function MoveNext(var Index: Integer): Boolean;
    function MovePrev(var Index: Integer): Boolean;
    procedure SetCapacity(AValue: Integer);
    procedure SetItems(const Index: Integer; const AValue: TItem);
    procedure Sort(Left, Right: Integer);
  protected
    property Data: PItem read FData;
  public
    destructor Destroy; override;
    function Add(const Item: TItem): Integer;
    function Compare(const A, B: TItem): Integer; virtual; // abstract;
    function Extract(const Index: Integer): TItem;
    function Find(const Item: TItem; out Index: Integer): Boolean;
    function GetEnumerator: TEnumerator;
    function Has(const Item: TItem): Boolean;
    function IndexOf(const Item: TItem): Integer;
    function Push(const Item: TItem): TItem;
    function Remove(const Item: TItem): Integer;
    function Reversed: TEnumeratorProvider;
    function SwapWith(const ItemAIndex: Integer; const ItemB: TItem): TItem;
    procedure Clear;
    procedure Delete(const Index: Integer);
    procedure Insert(const Index: Integer; const Item: TItem);
    procedure Pack;
    procedure Sort;
    procedure Swap(const ItemAIndex, ItemBIndex: Integer);
    property Capacity: Integer read FCapacity write SetCapacity;
    property Count: Integer read FCount;
    property First: TItem read GetFirst;
    property Items[const Index: Integer]: TItem read GetItems write SetItems; default;
    property Last: TItem read GetLast;
  end;

  { TheSortVector }

  generic TheSortVector<TItem> = class { http://code.google.com/p/fprb/wiki/TheSortVector }
  public type
    PItem = ^TItem;
    TEnumerator = specialize TheEnumerator<Integer, TItem>;
    TEnumeratorProvider = specialize TheEnumeratorProvider<TEnumerator>;
  private
    FCapacity: Integer;
    FCount: Integer;
    FData: PItem;
    function GetFirst: TItem;
    function GetItems(const Index: Integer): TItem;
    function GetCurrent(var Index: Integer): TItem;
    function GetLast: TItem;
    procedure Insert(const Index: Integer; const Item: TItem);
    function MoveNext(var Index: Integer): Boolean;
    function MovePrev(var Index: Integer): Boolean;
    procedure SetCapacity(AValue: Integer);
  protected
    property Data: PItem read FData;
  public
    destructor Destroy; override;
    function Add(const Item: TItem): Integer;
    function Extract(const Index: Integer): TItem;
    function Find(const Item: TItem; out Index: Integer): Boolean;
    function GetEnumerator: TEnumerator;
    function Has(const Item: TItem): Boolean;
    function IndexOf(const Item: TItem): Integer;
    function Push(const Item: TItem): TItem;
    function Remove(const Item: TItem): Integer;
    function Reversed: TEnumeratorProvider;
    procedure Clear;
    procedure Delete(const Index: Integer);
    procedure Pack;
    property Capacity: Integer read FCapacity write SetCapacity;
    property Count: Integer read FCount;
    property First: TItem read GetFirst;
    property Items[const Index: Integer]: TItem read GetItems; default;
    property Last: TItem read GetLast;
  end;

  { TheVectorSet }

  generic TheVectorSet<TItem> = class { http://code.google.com/p/fprb/wiki/TheVectorSet }
  public type
    PItem = ^TItem;
    TEnumerator = specialize TheEnumerator<Integer, TItem>;
    TEnumeratorProvider = specialize TheEnumeratorProvider<TEnumerator>;
  private
    FCapacity: Integer;
    FCount: Integer;
    FData: PItem;
    function Extract(const Index: Integer): TItem;
    function Find(const Item: TItem; out Index: Integer): Boolean;
    function GetFirst: TItem;
    function GetItem(const Index: Integer): TItem;
    function GetCurrent(var Index: Integer): TItem;
    function GetLast: TItem;
    function GetMembership(const Item: TItem): Boolean;
    procedure Insert(const Index: Integer; const Item: TItem);
    function MoveNext(var Index: Integer): Boolean;
    function MovePrev(var Index: Integer): Boolean;
    procedure SetCapacity(AValue: Integer);
    procedure SetMembership(const Item: TItem; const AValue: Boolean);
  protected
    property Data: PItem read FData;
  public
    destructor Destroy; override;
    function Exclude(const Item: TItem): Boolean; // true => was in set
    function GetEnumerator: TEnumerator;
    function Include(const Item: TItem): Boolean; // true => was in set
    function Reversed: TEnumeratorProvider;
    procedure Clear;
    procedure Pack;
    property Capacity: Integer read FCapacity write SetCapacity;
    property Count: Integer read FCount;
    property First: TItem read GetFirst;
    property Membership[const Item: TItem]: Boolean read GetMembership write SetMembership; default;
    property Last: TItem read GetLast;
  end;

  { TheVectorMap }

  generic TheVectorMap<TKey, TValue> = class { http://code.google.com/p/fprb/wiki/TheVectorMap }
  public type
    PItem = ^TItem;
    TItem = record
      Key: TKey;
      Value: TValue;
    end;
    TKeyEnumerator = specialize TheEnumerator<Integer, TKey>;
    TValueEnumerator = specialize TheEnumerator<Integer, TValue>;
    TKeyEnumeratorProvider = specialize TheEnumeratorProvider<TKeyEnumerator>;
    TValueEnumeratorProvider = specialize TheEnumeratorProvider<TValueEnumerator>;
  private
    FCapacity: Integer;
    FCount: Integer;
    FData: PItem;
    function GetFirst: TItem;
    function GetItem(const Index: Integer): TItem;
    function GetKey(const Index: Integer): TKey;
    function GetCurrentKey(var Index: Integer): TKey;
    function GetLast: TItem;
    function GetMap(const AKey: TKey): TValue;
    function GetValue(const Index: Integer): TValue;
    function GetCurrentValue(var Index: Integer): TValue;
    function MoveNext(var Index: Integer): Boolean;
    function MovePrev(var Index: Integer): Boolean;
    procedure Insert(const Index: Integer; const AKey: TKey; const AValue: TValue);
    procedure SetCapacity(AValue: Integer);
    procedure SetMap(const AKey: TKey; const AValue: TValue);
  protected
    property Data: PItem read FData;
    function MissingKeyValue(const AKey: TKey): TValue; virtual;
  public
    destructor Destroy; override;
    function Extract(const Index: Integer): TItem;
    function Find(const AKey: TKey; out Index: Integer): Boolean;
    function Has(const AKey: TKey): Boolean;
    function IndexOf(const AKey: TKey): Integer;
    function Keys: TKeyEnumeratorProvider;
    function KeysReversed: TKeyEnumeratorProvider;
    function Remove(const AKey: TKey): Integer;
    function Values: TValueEnumeratorProvider;
    function ValuesReversed: TValueEnumeratorProvider;
    procedure Clear;
    procedure Delete(const Index: Integer);
    procedure Pack;
    property Capacity: Integer read FCapacity write SetCapacity;
    property Count: Integer read FCount;
    property First: TItem read GetFirst;
    property Item[const Index: Integer]: TItem read GetItem;
    property Key[const Index: Integer]: TKey read GetKey;
    property Last: TItem read GetLast;
    property Map[const AKey: TKey]: TValue read GetMap write SetMap; default;
    property Value[const Index: Integer]: TValue read GetValue;
  end;

  { TheCmpVectorMap }

  generic TheCmpVectorMap<TKey, TValue> = class { http://code.google.com/p/fprb/wiki/TheCmpVectorMap }
  public type
    PItem = ^TItem;
    TItem = record
      Key: TKey;
      Value: TValue;
    end;
    TKeyEnumerator = specialize TheEnumerator<Integer, TKey>;
    TValueEnumerator = specialize TheEnumerator<Integer, TValue>;
    TKeyEnumeratorProvider = specialize TheEnumeratorProvider<TKeyEnumerator>;
    TValueEnumeratorProvider = specialize TheEnumeratorProvider<TValueEnumerator>;
  private
    FCapacity: Integer;
    FCount: Integer;
    FData: PItem;
    function GetFirst: TItem;
    function GetItem(const Index: Integer): TItem;
    function GetKey(const Index: Integer): TKey;
    function GetCurrentKey(var Index: Integer): TKey;
    function GetLast: TItem;
    function GetMap(const AKey: TKey): TValue;
    function GetValue(const Index: Integer): TValue;
    function GetCurrentValue(var Index: Integer): TValue;
    function MoveNext(var Index: Integer): Boolean;
    function MovePrev(var Index: Integer): Boolean;
    procedure Insert(const Index: Integer; const AKey: TKey; const AValue: TValue);
    procedure SetCapacity(AValue: Integer);
    procedure SetMap(const AKey: TKey; const AValue: TValue);
  protected
    property Data: PItem read FData;
    function MissingKeyValue(const AKey: TKey): TValue; virtual;
  public
    destructor Destroy; override;
    function Compare(const A, B: TKey): Integer; virtual; // abstract;
    function Extract(const Index: Integer): TItem;
    function Find(const AKey: TKey; out Index: Integer): Boolean;
    function Has(const AKey: TKey): Boolean;
    function IndexOf(const AKey: TKey): Integer;
    function Keys: TKeyEnumeratorProvider;
    function KeysReversed: TKeyEnumeratorProvider;
    function Remove(const AKey: TKey): Integer;
    function Values: TValueEnumeratorProvider;
    function ValuesReversed: TValueEnumeratorProvider;
    procedure Clear;
    procedure Delete(const Index: Integer);
    procedure Pack;
    property Capacity: Integer read FCapacity write SetCapacity;
    property Count: Integer read FCount;
    property First: TItem read GetFirst;
    property Item[const Index: Integer]: TItem read GetItem;
    property Key[const Index: Integer]: TKey read GetKey;
    property Last: TItem read GetLast;
    property Map[const AKey: TKey]: TValue read GetMap write SetMap; default;
    property Value[const Index: Integer]: TValue read GetValue;
  end;

  { TheObjectVectorMap }

  generic TheObjectVectorMap<TKey, TValue> = class { http://code.google.com/p/fprb/wiki/TheObjectVectorMap }
  public type
    PItem = ^TItem;
    TItem = record
      Key: TKey;
      Value: TValue;
    end;
    TKeyEnumerator = specialize TheEnumerator<Integer, TKey>;
    TValueEnumerator = specialize TheEnumerator<Integer, TValue>;
    TKeyEnumeratorProvider = specialize TheEnumeratorProvider<TKeyEnumerator>;
    TValueEnumeratorProvider = specialize TheEnumeratorProvider<TValueEnumerator>;
  private
    FCapacity: Integer;
    FCount: Integer;
    FData: PItem;
    FOwnObjects: Boolean;
    function GetFirst: TItem;
    function GetItem(const Index: Integer): TItem;
    function GetKey(const Index: Integer): TKey;
    function GetCurrentKey(var Index: Integer): TKey;
    function GetLast: TItem;
    function GetMap(const AKey: TKey): TValue;
    function GetValue(const Index: Integer): TValue;
    function GetCurrentValue(var Index: Integer): TValue;
    function MoveNext(var Index: Integer): Boolean;
    function MovePrev(var Index: Integer): Boolean;
    procedure Insert(const Index: Integer; const AKey: TKey; const AValue: TValue);
    procedure SetCapacity(AValue: Integer);
    procedure SetMap(const AKey: TKey; const AValue: TValue);
  protected
    property Data: PItem read FData;
    function MissingKeyValue(const AKey: TKey): TValue; virtual;
  public
    constructor Create(const AOwnObjects: Boolean = True);
    destructor Destroy; override;
    function Compare(const A, B: TKey): Integer; virtual; // abstract;
    function Extract(const Index: Integer): TItem;
    function Find(const AKey: TKey; out Index: Integer): Boolean;
    function Has(const AKey: TKey): Boolean;
    function IndexOf(const AKey: TKey): Integer;
    function Keys: TKeyEnumeratorProvider;
    function KeysReversed: TKeyEnumeratorProvider;
    function Remove(const AKey: TKey): Integer;
    function Values: TValueEnumeratorProvider;
    function ValuesReversed: TValueEnumeratorProvider;
    procedure Clear;
    procedure Delete(const Index: Integer);
    procedure Pack;
    property Capacity: Integer read FCapacity write SetCapacity;
    property Count: Integer read FCount;
    property First: TItem read GetFirst;
    property Item[const Index: Integer]: TItem read GetItem;
    property Key[const Index: Integer]: TKey read GetKey;
    property Last: TItem read GetLast;
    property Map[const AKey: TKey]: TValue read GetMap write SetMap; default;
    property OwnObjects: Boolean read FOwnObjects write FOwnObjects;
    property Value[const Index: Integer]: TValue read GetValue;
  end;

  { TheCmpVectorSet }

  generic TheCmpVectorSet<TItem> = class { http://code.google.com/p/fprb/wiki/TheCmpVectorSet }
  public type
    PItem = ^TItem;
    TEnumerator = specialize TheEnumerator<Integer, TItem>;
    TEnumeratorProvider = specialize TheEnumeratorProvider<TEnumerator>;
  private
    FCapacity: Integer;
    FCount: Integer;
    FData: PItem;
    function Extract(const Index: Integer): TItem;
    function Find(const Item: TItem; out Index: Integer): Boolean;
    function GetFirst: TItem;
    function GetItem(const Index: Integer): TItem;
    function GetCurrent(var Index: Integer): TItem;
    function GetLast: TItem;
    function GetMembership(const Item: TItem): Boolean;
    procedure Insert(const Index: Integer; const Item: TItem);
    function MoveNext(var Index: Integer): Boolean;
    function MovePrev(var Index: Integer): Boolean;
    procedure SetCapacity(AValue: Integer);
    procedure SetMembership(const Item: TItem; const AValue: Boolean);
  protected
    property Data: PItem read FData;
  public
    destructor Destroy; override;
    function Compare(const A, B: TItem): Integer; virtual; // abstract;
    function Exclude(const Item: TItem): Boolean; // true => was in set
    function GetEnumerator: TEnumerator;
    function Include(const Item: TItem): Boolean; // true => was in set
    function Reversed: TEnumeratorProvider;
    procedure Clear;
    procedure Pack;
    property Capacity: Integer read FCapacity write SetCapacity;
    property Count: Integer read FCount;
    property First: TItem read GetFirst;
    property Membership[const Item: TItem]: Boolean read GetMembership write SetMembership; default;
    property Last: TItem read GetLast;
  end;

  { TheObjectVectorSet }

  generic TheObjectVectorSet<TItem> = class { http://code.google.com/p/fprb/wiki/TheObjectVectorSet }
  public type
    PItem = ^TItem;
    TEnumerator = specialize TheEnumerator<Integer, TItem>;
    TEnumeratorProvider = specialize TheEnumeratorProvider<TEnumerator>;
  private
    FCapacity: Integer;
    FCount: Integer;
    FData: PItem;
    FOwnObjects: Boolean;
    function Extract(const Index: Integer): TItem;
    function Find(const Item: TItem; out Index: Integer): Boolean;
    function GetFirst: TItem;
    function GetItem(const Index: Integer): TItem;
    function GetCurrent(var Index: Integer): TItem;
    function GetLast: TItem;
    function GetMembership(const Item: TItem): Boolean;
    procedure Insert(const Index: Integer; const Item: TItem);
    function MoveNext(var Index: Integer): Boolean;
    function MovePrev(var Index: Integer): Boolean;
    procedure SetCapacity(AValue: Integer);
    procedure SetMembership(const Item: TItem; const AValue: Boolean);
  protected
    property Data: PItem read FData;
  public
    constructor Create(const AOwnObjects: Boolean = True);
    destructor Destroy; override;
    function Compare(const A, B: TItem): Integer; virtual; // abstract;
    function Exclude(const Item: TItem): Boolean; // true => was in set
    function GetEnumerator: TEnumerator;
    function Include(const Item: TItem): Boolean; // true => was in set
    function Reversed: TEnumeratorProvider;
    procedure Clear;
    procedure Kill;
    procedure Pack;
    procedure Wipe;
    property Capacity: Integer read FCapacity write SetCapacity;
    property Count: Integer read FCount;
    property First: TItem read GetFirst;
    property Membership[const Item: TItem]: Boolean read GetMembership write SetMembership; default;
    property Last: TItem read GetLast;
    property OwnObjects: Boolean read FOwnObjects write FOwnObjects;
  end;

  { TheCmpSortVector }

  generic TheCmpSortVector<TItem> = class { http://code.google.com/p/fprb/wiki/TheCmpSortVector }
  public type
    PItem = ^TItem;
    TEnumerator = specialize TheEnumerator<Integer, TItem>;
    TEnumeratorProvider = specialize TheEnumeratorProvider<TEnumerator>;
  private
    FCapacity: Integer;
    FCount: Integer;
    FData: PItem;
    function GetFirst: TItem;
    function GetItems(const Index: Integer): TItem;
    function GetCurrent(var Index: Integer): TItem;
    function GetLast: TItem;
    procedure Insert(const Index: Integer; const Item: TItem);
    function MoveNext(var Index: Integer): Boolean;
    function MovePrev(var Index: Integer): Boolean;
    procedure SetCapacity(AValue: Integer);
  protected
    property Data: PItem read FData;
  public
    destructor Destroy; override;
    function Add(const Item: TItem): Integer;
    function Compare(const A, B: TItem): Integer; virtual; // abstract;
    function Extract(const Index: Integer): TItem;
    function Find(const Item: TItem; out Index: Integer): Boolean;
    function GetEnumerator: TEnumerator;
    function Has(const Item: TItem): Boolean;
    function IndexOf(const Item: TItem): Integer;
    function Push(const Item: TItem): TItem;
    function Remove(const Item: TItem): Integer;
    function Reversed: TEnumeratorProvider;
    procedure Clear;
    procedure Delete(const Index: Integer);
    procedure Pack;
    property Capacity: Integer read FCapacity write SetCapacity;
    property Count: Integer read FCount;
    property First: TItem read GetFirst;
    property Items[const Index: Integer]: TItem read GetItems; default;
    property Last: TItem read GetLast;
  end;

  { TheObjectSortVector }

  generic TheObjectSortVector<TItem> = class { http://code.google.com/p/fprb/wiki/TheObjectSortVector }
  public type
    PItem = ^TItem;
    TEnumerator = specialize TheEnumerator<Integer, TItem>;
    TEnumeratorProvider = specialize TheEnumeratorProvider<TEnumerator>;
  private
    FCapacity: Integer;
    FCount: Integer;
    FData: PItem;
    FOwnObjects: Boolean;
    function GetFirst: TItem;
    function GetItems(const Index: Integer): TItem;
    function GetCurrent(var Index: Integer): TItem;
    function GetLast: TItem;
    procedure Insert(const Index: Integer; const Item: TItem);
    function MoveNext(var Index: Integer): Boolean;
    function MovePrev(var Index: Integer): Boolean;
    procedure SetCapacity(AValue: Integer);
  protected
    property Data: PItem read FData;
  public
    constructor Create(const AOwnObjects: Boolean = True);
    destructor Destroy; override;
    function Add(const Item: TItem): Integer;
    function Compare(const A, B: TItem): Integer; virtual; // abstract;
    function Extract(const Index: Integer): TItem;
    function Find(const Item: TItem; out Index: Integer): Boolean;
    function GetEnumerator: TEnumerator;
    function Has(const Item: TItem): Boolean;
    function IndexOf(const Item: TItem): Integer;
    function Push(const Item: TItem): TItem;
    function Remove(const Item: TItem): Integer;
    function Reversed: TEnumeratorProvider;
    procedure Clear;
    procedure Delete(const Index: Integer);
    procedure Kill;
    procedure Pack;
    procedure Wipe;
    property Capacity: Integer read FCapacity write SetCapacity;
    property Count: Integer read FCount;
    property First: TItem read GetFirst;
    property Items[const Index: Integer]: TItem read GetItems; default;
    property Last: TItem read GetLast;
    property OwnObjects: Boolean read FOwnObjects write FOwnObjects;
  end;

  { TheList }

  generic TheList<TItem> = class { http://code.google.com/p/fprb/wiki/TheList }
  public type
    PNode = ^TNode;
    TNode = object
    private
      FNext: PNode;
      FPrev: PNode;
    public
      Item: TItem;
      property Next: PNode read FNext;
      property Prev: PNode read FPrev;
    end;
  private type
    TIterator = record
      List: TObject;
      Node: PNode;
    end;
  public type
    TEnumerator = specialize TheEnumerator<TIterator, TItem>;
    TEnumeratorProvider = specialize TheEnumeratorProvider<TEnumerator>;
  private type
    PNode_ = ^TNode_;
    TNode_ = object
    public
      FNext: PNode_;
      FPrev: PNode_;
      FItem: TItem;
    end;
  private
    FCount: Integer;
    FFirst: PNode;
    FLast: PNode;
    function CurrentItem(var Iterator: TIterator): TItem;
    function InsertAfter_(const After, Node: PNode): PNode;
    function InsertBack(const Node: PNode): PNode;
    function InsertBefore_(const Node, Before: PNode): PNode;
    function InsertFront(const Node: PNode): PNode;
    function MoveNext(var Iterator: TIterator): Boolean;
    function MovePrev(var Iterator: TIterator): Boolean;
    function NewIterator: TIterator;
    function NewNode(const AItem: TItem): PNode;
  public
    destructor Destroy; override;
    function Extract(const Node: PNode): PNode;
    function GetEnumerator: TEnumerator;
    function InsertAfter(const After: PNode; const AItem: TItem): PNode;
    function InsertBefore(const AItem: TItem; const Before: PNode): PNode;
    function MoveAfter(const After, Node: PNode): PNode;
    function MoveBefore(const Node, Before: PNode): PNode;
    function MoveToBack(const Node: PNode): PNode;
    function MoveToFront(const Node: PNode): PNode;
    function PushBack(const AItem: TItem): PNode;
    function PushFront(const AItem: TItem): PNode;
    function Reversed: TEnumeratorProvider;
    procedure Clear;
    procedure Remove(Node: PNode);
    property Count: Integer read FCount;
    property First: PNode read FFirst;
    property Last: PNode read FLast;
  end;

  { TheObjectList }

  generic TheObjectList<TItem> = class { http://code.google.com/p/fprb/wiki/TheObjectList }
  public type
    PNode = ^TNode;
    TNode = object
    private
      FNext: PNode;
      FPrev: PNode;
    public
      Item: TItem;
      property Next: PNode read FNext;
      property Prev: PNode read FPrev;
    end;
  private type
    TIterator = record
      List: TObject;
      Node: PNode;
    end;
  public type
    TEnumerator = specialize TheEnumerator<TIterator, TItem>;
    TEnumeratorProvider = specialize TheEnumeratorProvider<TEnumerator>;
  private type
    PNode_ = ^TNode_;
    TNode_ = object
    public
      FNext: PNode_;
      FPrev: PNode_;
      FItem: TItem;
    end;
  private
    FCount: Integer;
    FFirst: PNode;
    FLast: PNode;
    FOwnObjects: Boolean;
    function CurrentItem(var Iterator: TIterator): TItem;
    function InsertAfter_(const After, Node: PNode): PNode;
    function InsertBack(const Node: PNode): PNode;
    function InsertBefore_(const Node, Before: PNode): PNode;
    function InsertFront(const Node: PNode): PNode;
    function MoveNext(var Iterator: TIterator): Boolean;
    function MovePrev(var Iterator: TIterator): Boolean;
    function NewIterator: TIterator;
    function NewNode(const AItem: TItem): PNode;
  public
    constructor Create(const AOwnObjects: Boolean = True);
    destructor Destroy; override;
    function Extract(const Node: PNode): PNode;
    function GetEnumerator: TEnumerator;
    function InsertAfter(const After: PNode; const AItem: TItem): PNode;
    function InsertBefore(const AItem: TItem; const Before: PNode): PNode;
    function MoveAfter(const After, Node: PNode): PNode;
    function MoveBefore(const Node, Before: PNode): PNode;
    function MoveToBack(const Node: PNode): PNode;
    function MoveToFront(const Node: PNode): PNode;
    function PushBack(const AItem: TItem): PNode;
    function PushFront(const AItem: TItem): PNode;
    function Reversed: TEnumeratorProvider;
    procedure Clear;
    procedure Remove(Node: PNode);
    property Count: Integer read FCount;
    property First: PNode read FFirst;
    property Last: PNode read FLast;
    property OwnObjects: Boolean read FOwnObjects write FOwnObjects;
  end;

  { TheBTreeSet }

  generic TheBTreeSet<TItem> = class { http://code.google.com/p/fprb/wiki/TheBTreeSet }
  private type
    PPage = ^TPage;
    PData = ^TDataPage;
    PIndex = ^TIndexPage;
    TPage = packed record // object
      Count: Integer;
      IsIndex: LongBool;
    end;
    TIndexPage = packed record // object(TPage)
      Hdr: TPage; // must be first
      Index: array[0..1] of record
        Child: PPage; // ^Index or data page, count in KIndex-1..2*KIndex+2 items except root
        DataPage: PData; // ^Data page, count in KIndex-1..2*KIndex+1 items except root
      end;
    end;
    TDataPage = packed record // object(TPage)
      Hdr: TPage; // must be first
      Prev, Next: PData;
      Data: array[0..1] of TItem // KData-1..2*KData items
    end;
    TIterator = record
      Page: PData;
      Index: Integer;
      UseSentinel: Boolean;
      Sentinel: TItem;
    end;
  public type
    TEnumerator = specialize TheEnumerator<TIterator, TItem>;
    TEnumeratorProvider = specialize TheEnumeratorProvider<TEnumerator>;
  private
    FCount: Integer;
    FFirst: PPage;
    FKData: Integer;
    FKIndex: Integer;
    FLast: PPage;
    FRoot: PPage;
  private
    function ExtractData(const P: PPage; const Index: Integer): TItem;
    function Find(const P: PPage; const Item: TItem; out Index: Integer): Boolean;
    function GetFirst: TItem;
    function GetLast: TItem;
    function GetCurrent(var Iterator: TIterator): TItem;
    function GetMembership(const Item: TItem): Boolean;
    function GetRange(const RangeFrom, RangeTo: TItem): TEnumeratorProvider;
    function Insert(const P: PPage; const Index: Integer): PPage;
    function Insert(const P: PPage; const Index: Integer; const DataPage, Child: PPage): PPage;
    function InsertItem(const P: PPage; const Index: Integer; const Item: TItem): PPage;
    function MoveNext(var Iterator: TIterator): Boolean;
    function MovePrev(var Iterator: TIterator): Boolean;
    function Page(const IsIndex: Boolean; const LeftmostChild: PPage = nil): PPage;
    function Seek(const Item: TItem; out P: PData; out Index: Integer): Boolean;
    procedure CheckSiblings(const Parent: PPage; const ParentIndex: Integer; out Left, Right: PPage);
    procedure Clear(const P: PPage);
    procedure Concat(const Parent, P, Right: PPage; const ParentIndex: Integer);
    procedure ConcatIndex(const Parent, P, Right: PPage; const ParentIndex: Integer);
    procedure ExtractIndex(const P: PPage; const Index: Integer);
    procedure MoveLeft(const Left, P: PPage; const N: Integer = 1);
    procedure MoveRight(const P, Right: PPage; const N: Integer = 1);
    procedure Overflow(const Parent, P: PPage; const ParentIndex, Index: Integer; const Item: TItem);
    procedure SetMembership(const Item: TItem; const AValue: Boolean);
    procedure SplitData(const Parent, P: PPage; const ParentIndex, Index: Integer; const Item: TItem);
    procedure SplitIndex(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
    procedure Underflow(const Parent, P: PPage; const ParentIndex: Integer);
    procedure Underflow(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
    property Root: PPage Read FRoot;
  public
    constructor Create(const AKIndex: Integer = 64; const AKData: Integer = 32);
    destructor Destroy; override;
    function Exclude(const Item: TItem): Boolean;
    function GetEnumerator: TEnumerator;
    function Include(const Item: TItem): Boolean;
    function Reversed: TEnumeratorProvider;
    procedure Clear;
    property Count: Integer Read FCount;
    property First: TItem read GetFirst;
    property KData: Integer Read FKData;
    property KIndex: Integer Read FKIndex;
    property Last: TItem read GetLast;
    property Membership[const Item: TItem]: Boolean read GetMembership write SetMembership; default;
    property Range[const RangeFrom, RangeTo: TItem]: TEnumeratorProvider read GetRange;
  end;

  { TheCmpBTreeSet }

  generic TheCmpBTreeSet<TItem> = class { http://code.google.com/p/fprb/wiki/TheCmpBTreeSet }
  private type
    PPage = ^TPage;
    PData = ^TDataPage;
    PIndex = ^TIndexPage;
    TPage = packed record // object
      Count: Integer;
      IsIndex: LongBool;
    end;
    TIndexPage = packed record // object(TPage)
      Hdr: TPage; // must be first
      Index: array[0..1] of record
        Child: PPage; // ^Index or data page, count in KIndex-1..2*KIndex+2 items except root
        DataPage: PData; // ^Data page, count in KIndex-1..2*KIndex+1 items except root
      end;
    end;
    TDataPage = packed record // object(TPage)
      Hdr: TPage; // must be first
      Prev, Next: PData;
      Data: array[0..1] of TItem // KData-1..2*KData items
    end;
    TIterator = record
      Page: PData;
      Index: Integer;
      UseSentinel: Boolean;
      Sentinel: TItem;
    end;
  public type
    TEnumerator = specialize TheEnumerator<TIterator, TItem>;
    TEnumeratorProvider = specialize TheEnumeratorProvider<TEnumerator>;
  private
    FCount: Integer;
    FFirst: PPage;
    FKData: Integer;
    FKIndex: Integer;
    FLast: PPage;
    FRoot: PPage;
  private
    function ExtractData(const P: PPage; const Index: Integer): TItem;
    function Find(const P: PPage; const Item: TItem; out Index: Integer): Boolean;
    function GetFirst: TItem;
    function GetLast: TItem;
    function GetCurrent(var Iterator: TIterator): TItem;
    function GetMembership(const Item: TItem): Boolean;
    function GetRange(const RangeFrom, RangeTo: TItem): TEnumeratorProvider;
    function Insert(const P: PPage; const Index: Integer): PPage;
    function Insert(const P: PPage; const Index: Integer; const DataPage, Child: PPage): PPage;
    function InsertItem(const P: PPage; const Index: Integer; const Item: TItem): PPage;
    function MoveNext(var Iterator: TIterator): Boolean;
    function MovePrev(var Iterator: TIterator): Boolean;
    function Page(const IsIndex: Boolean; const LeftmostChild: PPage = nil): PPage;
    function Seek(const Item: TItem; out P: PData; out Index: Integer): Boolean;
    procedure CheckSiblings(const Parent: PPage; const ParentIndex: Integer; out Left, Right: PPage);
    procedure Clear(const P: PPage);
    procedure Concat(const Parent, P, Right: PPage; const ParentIndex: Integer);
    procedure ConcatIndex(const Parent, P, Right: PPage; const ParentIndex: Integer);
    procedure ExtractIndex(const P: PPage; const Index: Integer);
    procedure MoveLeft(const Left, P: PPage; const N: Integer = 1);
    procedure MoveRight(const P, Right: PPage; const N: Integer = 1);
    procedure Overflow(const Parent, P: PPage; const ParentIndex, Index: Integer; const Item: TItem);
    procedure SetMembership(const Item: TItem; const AValue: Boolean);
    procedure SplitData(const Parent, P: PPage; const ParentIndex, Index: Integer; const Item: TItem);
    procedure SplitIndex(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
    procedure Underflow(const Parent, P: PPage; const ParentIndex: Integer);
    procedure Underflow(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
    property Root: PPage Read FRoot;
  public
    constructor Create(const AKIndex: Integer = 64; const AKData: Integer = 32);
    destructor Destroy; override;
    function Compare(const A, B: TItem): Integer; virtual; // abstract
    function Exclude(const Item: TItem): Boolean;
    function GetEnumerator: TEnumerator;
    function Include(const Item: TItem): Boolean;
    function Reversed: TEnumeratorProvider;
    procedure Clear;
    property Count: Integer Read FCount;
    property First: TItem read GetFirst;
    property KData: Integer Read FKData;
    property KIndex: Integer Read FKIndex;
    property Last: TItem read GetLast;
    property Membership[const Item: TItem]: Boolean read GetMembership write SetMembership; default;
    property Range[const RangeFrom, RangeTo: TItem]: TEnumeratorProvider read GetRange;
  end;

  { TheObjectBTreeSet }

  generic TheObjectBTreeSet<TItem> = class { http://code.google.com/p/fprb/wiki/TheObjectBTreeSet }
  private type
    PPage = ^TPage;
    PData = ^TDataPage;
    PIndex = ^TIndexPage;
    TPage = packed record // object
      Count: Integer;
      IsIndex: LongBool;
    end;
    TIndexPage = packed record // object(TPage)
      Hdr: TPage; // must be first
      Index: array[0..1] of record
        Child: PPage; // ^Index or data page, count in KIndex-1..2*KIndex+2 items except root
        DataPage: PData; // ^Data page, count in KIndex-1..2*KIndex+1 items except root
      end;
    end;
    TDataPage = packed record // object(TPage)
      Hdr: TPage; // must be first
      Prev, Next: PData;
      Data: array[0..1] of TItem // KData-1..2*KData items
    end;
    TIterator = record
      Page: PData;
      Index: Integer;
      UseSentinel: Boolean;
      Sentinel: TItem;
    end;
  public type
    TEnumerator = specialize TheEnumerator<TIterator, TItem>;
    TEnumeratorProvider = specialize TheEnumeratorProvider<TEnumerator>;
  private
    FCount: Integer;
    FFirst: PPage;
    FKData: Integer;
    FKIndex: Integer;
    FLast: PPage;
    FOwnObjects: Boolean;
    FRoot: PPage;
  private
    function ExtractData(const P: PPage; const Index: Integer): TItem;
    function Find(const P: PPage; const Item: TItem; out Index: Integer): Boolean;
    function GetFirst: TItem;
    function GetLast: TItem;
    function GetCurrent(var Iterator: TIterator): TItem;
    function GetMembership(const Item: TItem): Boolean;
    function GetRange(const RangeFrom, RangeTo: TItem): TEnumeratorProvider;
    function Insert(const P: PPage; const Index: Integer): PPage;
    function Insert(const P: PPage; const Index: Integer; const DataPage, Child: PPage): PPage;
    function InsertItem(const P: PPage; const Index: Integer; const Item: TItem): PPage;
    function MoveNext(var Iterator: TIterator): Boolean;
    function MovePrev(var Iterator: TIterator): Boolean;
    function Page(const IsIndex: Boolean; const LeftmostChild: PPage = nil): PPage;
    function Seek(const Item: TItem; out P: PData; out Index: Integer): Boolean;
    procedure CheckSiblings(const Parent: PPage; const ParentIndex: Integer; out Left, Right: PPage);
    procedure Clear(const P: PPage);
    procedure Concat(const Parent, P, Right: PPage; const ParentIndex: Integer);
    procedure ConcatIndex(const Parent, P, Right: PPage; const ParentIndex: Integer);
    procedure ExtractIndex(const P: PPage; const Index: Integer);
    procedure MoveLeft(const Left, P: PPage; const N: Integer = 1);
    procedure MoveRight(const P, Right: PPage; const N: Integer = 1);
    procedure Overflow(const Parent, P: PPage; const ParentIndex, Index: Integer; const Item: TItem);
    procedure SetMembership(const Item: TItem; const AValue: Boolean);
    procedure SplitData(const Parent, P: PPage; const ParentIndex, Index: Integer; const Item: TItem);
    procedure SplitIndex(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
    procedure Underflow(const Parent, P: PPage; const ParentIndex: Integer);
    procedure Underflow(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
    property Root: PPage Read FRoot;
  public
    constructor Create(const AOwnObjects: Boolean = True; const AKIndex: Integer = 64; const AKData: Integer = 32);
    destructor Destroy; override;
    function Compare(const A, B: TItem): Integer; virtual; // abstract
    function Exclude(const Item: TItem): Boolean;
    function GetEnumerator: TEnumerator;
    function Include(const Item: TItem): Boolean;
    function Reversed: TEnumeratorProvider;
    procedure Clear;
    property Count: Integer Read FCount;
    property First: TItem read GetFirst;
    property KData: Integer Read FKData;
    property KIndex: Integer Read FKIndex;
    property Last: TItem read GetLast;
    property Membership[const Item: TItem]: Boolean read GetMembership write SetMembership; default;
    property OwnObjects: Boolean read FOwnObjects write FOwnObjects;
    property Range[const RangeFrom, RangeTo: TItem]: TEnumeratorProvider read GetRange;
  end;

  { TheBTreeMap }

  generic TheBTreeMap<TKey, TValue> = class { http://code.google.com/p/fprb/wiki/TheBTreeMap }
  private type
    PPage = ^TPage;
    PData = ^TDataPage;
    PIndex = ^TIndexPage;
    TPage = packed record // object
      Count: Integer;
      IsIndex: LongBool;
    end;
    TIndexPage = packed record // object(TPage)
      Hdr: TPage; // must be first
      Index: array[0..1] of record
        Child: PPage; // ^Index or data page, count in KIndex-1..2*KIndex+2 items except root
        DataPage: PData; // ^Data page, count in KIndex-1..2*KIndex+1 items except root
      end;
    end;
    TItem = packed record
        Key: TKey;
        Value: TValue;
    end;
    TDataPage = packed record // object(TPage)
      Hdr: TPage; // must be first
      Prev, Next: PData;
      Data: array[0..1] of TItem; // KData-1..2*KData items
    end;
    TIterator = record
      Page: PData;
      Index: Integer;
      UseSentinel: Boolean;
      Sentinel: TKey;
    end;
  public type
    TKeyEnumerator = specialize TheEnumerator<TIterator, TKey>;
    TValueEnumerator = specialize TheEnumerator<TIterator, TValue>;
    TKeyEnumeratorProvider = specialize TheEnumeratorProvider<TKeyEnumerator>;
    TValueEnumeratorProvider = specialize TheEnumeratorProvider<TValueEnumerator>;
  private
    FCount: Integer;
    FFirst: PPage;
    FKData: Integer;
    FKIndex: Integer;
    FLast: PPage;
    FRoot: PPage;
  private
    function ExtractData(const P: PPage; const Index: Integer): TValue;
    function Find(const P: PPage; const Key: TKey; out Index: Integer): Boolean;
    function GetCurrent(var Iterator: TIterator): TValue;
    function GetCurrentKey(var Iterator: TIterator): TKey;
    function GetFirst: TValue;
    function GetFirstKey: TKey;
    function GetLast: TValue;
    function GetLastKey: TKey;
    function GetMap(const Key: TKey): TValue;
    function GetRange(const RangeFrom, RangeTo: TKey): TValueEnumeratorProvider;
    function GetRangeKeys(const RangeFrom, RangeTo: TKey): TKeyEnumeratorProvider;
    function Insert(const P: PPage; const Index: Integer): PPage;
    function Insert(const P: PPage; const Index: Integer; const DataPage, Child: PPage): PPage;
    function InsertItem(const P: PPage; const Index: Integer; const Key: TKey; const Value: TValue): PPage;
    function MoveNext(var Iterator: TIterator): Boolean;
    function MovePrev(var Iterator: TIterator): Boolean;
    function Page(const IsIndex: Boolean; const LeftmostChild: PPage = nil): PPage;
    function Seek(const Key: TKey; out P: PData; out Index: Integer): Boolean;
    procedure CheckSiblings(const Parent: PPage; const ParentIndex: Integer; out Left, Right: PPage);
    procedure Clear(const P: PPage);
    procedure Concat(const Parent, P, Right: PPage; const ParentIndex: Integer);
    procedure ConcatIndex(const Parent, P, Right: PPage; const ParentIndex: Integer);
    procedure ExtractIndex(const P: PPage; const Index: Integer);
    procedure MoveLeft(const Left, P: PPage; const N: Integer = 1);
    procedure MoveRight(const P, Right: PPage; const N: Integer = 1);
    procedure Overflow(const Parent, P: PPage; const ParentIndex, Index: Integer; const Key: TKey; const Value: TValue);
    procedure SetMap(const Key: TKey; const Value: TValue);
    procedure SplitData(const Parent, P: PPage; const ParentIndex, Index: Integer; const Key: TKey; const Value: TValue);
    procedure SplitIndex(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
    procedure Swap(var Dest: TValue; const Value: TValue; out Prev: TValue; const CanOverwrite: Boolean);
    procedure Underflow(const Parent, P: PPage; const ParentIndex: Integer);
    procedure Underflow(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
    property Root: PPage Read FRoot;
  protected
    function MissingKeyValue(const Key: TKey): TValue; virtual;
  public
    constructor Create(const AKIndex: Integer = 64; const AKData: Integer = 32);
    destructor Destroy; override;
    function Delete(const Key: TKey): Boolean;
    function Extract(const Key: TKey; out Value: TValue): Boolean;
    function Get(const Key: TKey; out Value: TValue): Boolean;
    function Put(const Key: TKey; const Value: TValue; const CanOverwrite: Boolean = True): Boolean;
    function Put(const Key: TKey; const Value: TValue; out Prev: TValue; const CanOverwrite: Boolean = True): Boolean;
    function Keys: TKeyEnumeratorProvider;
    function KeysReversed: TKeyEnumeratorProvider;
    function Values: TValueEnumeratorProvider;
    function ValuesReversed: TValueEnumeratorProvider;
    procedure Clear;
    property Count: Integer Read FCount;
    property First: TValue read GetFirst;
    property FirstKey: TKey read GetFirstKey;
    property KData: Integer Read FKData;
    property KIndex: Integer Read FKIndex;
    property Last: TValue read GetLast;
    property LastKey: TKey read GetLastKey;
    property Map[const Key: TKey]: TValue read GetMap write SetMap; default;
    property Range[const RangeFrom, RangeTo: TKey]: TValueEnumeratorProvider read GetRange;
    property RangeKeys[const RangeFrom, RangeTo: TKey]: TKeyEnumeratorProvider read GetRangeKeys;
  end;

  { TheCmpBTreeMap }

  generic TheCmpBTreeMap<TKey, TValue> = class { http://code.google.com/p/fprb/wiki/TheCmpBTreeMap }
  private type
    PPage = ^TPage;
    PData = ^TDataPage;
    PIndex = ^TIndexPage;
    TPage = packed record // object
      Count: Integer;
      IsIndex: LongBool;
    end;
    TIndexPage = packed record // object(TPage)
      Hdr: TPage; // must be first
      Index: array[0..1] of record
        Child: PPage; // ^Index or data page, count in KIndex-1..2*KIndex+2 items except root
        DataPage: PData; // ^Data page, count in KIndex-1..2*KIndex+1 items except root
      end;
    end;
    TItem = packed record
        Key: TKey;
        Value: TValue;
    end;
    TDataPage = packed record // object(TPage)
      Hdr: TPage; // must be first
      Prev, Next: PData;
      Data: array[0..1] of TItem; // KData-1..2*KData items
    end;
    TIterator = record
      Page: PData;
      Index: Integer;
      UseSentinel: Boolean;
      Sentinel: TKey;
    end;
  public type
    TKeyEnumerator = specialize TheEnumerator<TIterator, TKey>;
    TValueEnumerator = specialize TheEnumerator<TIterator, TValue>;
    TKeyEnumeratorProvider = specialize TheEnumeratorProvider<TKeyEnumerator>;
    TValueEnumeratorProvider = specialize TheEnumeratorProvider<TValueEnumerator>;
  private
    FCount: Integer;
    FFirst: PPage;
    FKData: Integer;
    FKIndex: Integer;
    FLast: PPage;
    FRoot: PPage;
  private
    function ExtractData(const P: PPage; const Index: Integer): TValue;
    function Find(const P: PPage; const Key: TKey; out Index: Integer): Boolean;
    function GetCurrent(var Iterator: TIterator): TValue;
    function GetCurrentKey(var Iterator: TIterator): TKey;
    function GetFirst: TValue;
    function GetFirstKey: TKey;
    function GetLast: TValue;
    function GetLastKey: TKey;
    function GetMap(const Key: TKey): TValue;
    function GetRange(const RangeFrom, RangeTo: TKey): TValueEnumeratorProvider;
    function GetRangeKeys(const RangeFrom, RangeTo: TKey): TKeyEnumeratorProvider;
    function Insert(const P: PPage; const Index: Integer): PPage;
    function Insert(const P: PPage; const Index: Integer; const DataPage, Child: PPage): PPage;
    function InsertItem(const P: PPage; const Index: Integer; const Key: TKey; const Value: TValue): PPage;
    function MoveNext(var Iterator: TIterator): Boolean;
    function MovePrev(var Iterator: TIterator): Boolean;
    function Page(const IsIndex: Boolean; const LeftmostChild: PPage = nil): PPage;
    function Seek(const Key: TKey; out P: PData; out Index: Integer): Boolean;
    procedure CheckSiblings(const Parent: PPage; const ParentIndex: Integer; out Left, Right: PPage);
    procedure Clear(const P: PPage);
    procedure Concat(const Parent, P, Right: PPage; const ParentIndex: Integer);
    procedure ConcatIndex(const Parent, P, Right: PPage; const ParentIndex: Integer);
    procedure ExtractIndex(const P: PPage; const Index: Integer);
    procedure MoveLeft(const Left, P: PPage; const N: Integer = 1);
    procedure MoveRight(const P, Right: PPage; const N: Integer = 1);
    procedure Overflow(const Parent, P: PPage; const ParentIndex, Index: Integer; const Key: TKey; const Value: TValue);
    procedure SetMap(const Key: TKey; const Value: TValue);
    procedure SplitData(const Parent, P: PPage; const ParentIndex, Index: Integer; const Key: TKey; const Value: TValue);
    procedure SplitIndex(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
    procedure Swap(var Dest: TValue; const Value: TValue; out Prev: TValue; const CanOverwrite: Boolean);
    procedure Underflow(const Parent, P: PPage; const ParentIndex: Integer);
    procedure Underflow(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
    property Root: PPage Read FRoot;
  protected
    function MissingKeyValue(const Key: TKey): TValue; virtual;
  public
    constructor Create(const AKIndex: Integer = 64; const AKData: Integer = 32);
    destructor Destroy; override;
    function Compare(const A, B: TKey): Integer; virtual; // abstract
    function Delete(const Key: TKey): Boolean;
    function Extract(const Key: TKey; out Value: TValue): Boolean;
    function Get(const Key: TKey; out Value: TValue): Boolean;
    function Put(const Key: TKey; const Value: TValue; const CanOverwrite: Boolean = True): Boolean;
    function Put(const Key: TKey; const Value: TValue; out Prev: TValue; const CanOverwrite: Boolean = True): Boolean;
    function Keys: TKeyEnumeratorProvider;
    function KeysReversed: TKeyEnumeratorProvider;
    function Values: TValueEnumeratorProvider;
    function ValuesReversed: TValueEnumeratorProvider;
    procedure Clear;
    property Count: Integer Read FCount;
    property First: TValue read GetFirst;
    property FirstKey: TKey read GetFirstKey;
    property KData: Integer Read FKData;
    property KIndex: Integer Read FKIndex;
    property Last: TValue read GetLast;
    property LastKey: TKey read GetLastKey;
    property Map[const Key: TKey]: TValue read GetMap write SetMap; default;
    property Range[const RangeFrom, RangeTo: TKey]: TValueEnumeratorProvider read GetRange;
    property RangeKeys[const RangeFrom, RangeTo: TKey]: TKeyEnumeratorProvider read GetRangeKeys;
  end;

  { TheObjectBTreeMap }

  generic TheObjectBTreeMap<TKey, TValue> = class { http://code.google.com/p/fprb/wiki/TheObjectBTreeMap }
  private type
    PPage = ^TPage;
    PData = ^TDataPage;
    PIndex = ^TIndexPage;
    TPage = packed record // object
      Count: Integer;
      IsIndex: LongBool;
    end;
    TIndexPage = packed record // object(TPage)
      Hdr: TPage; // must be first
      Index: array[0..1] of record
        Child: PPage; // ^Index or data page, count in KIndex-1..2*KIndex+2 items except root
        DataPage: PData; // ^Data page, count in KIndex-1..2*KIndex+1 items except root
      end;
    end;
    TItem = packed record
        Key: TKey;
        Value: TValue;
    end;
    TDataPage = packed record // object(TPage)
      Hdr: TPage; // must be first
      Prev, Next: PData;
      Data: array[0..1] of TItem; // KData-1..2*KData items
    end;
    TIterator = record
      Page: PData;
      Index: Integer;
      UseSentinel: Boolean;
      Sentinel: TKey;
    end;
  public type
    TKeyEnumerator = specialize TheEnumerator<TIterator, TKey>;
    TValueEnumerator = specialize TheEnumerator<TIterator, TValue>;
    TKeyEnumeratorProvider = specialize TheEnumeratorProvider<TKeyEnumerator>;
    TValueEnumeratorProvider = specialize TheEnumeratorProvider<TValueEnumerator>;
  private
    FCount: Integer;
    FFirst: PPage;
    FKData: Integer;
    FKIndex: Integer;
    FLast: PPage;
    FOwnObjects: Boolean;
    FRoot: PPage;
  private
    function ExtractData(const P: PPage; const Index: Integer): TValue;
    function Find(const P: PPage; const Key: TKey; out Index: Integer): Boolean;
    function GetCurrent(var Iterator: TIterator): TValue;
    function GetCurrentKey(var Iterator: TIterator): TKey;
    function GetFirst: TValue;
    function GetFirstKey: TKey;
    function GetLast: TValue;
    function GetLastKey: TKey;
    function GetMap(const Key: TKey): TValue;
    function GetRange(const RangeFrom, RangeTo: TKey): TValueEnumeratorProvider;
    function GetRangeKeys(const RangeFrom, RangeTo: TKey): TKeyEnumeratorProvider;
    function Insert(const P: PPage; const Index: Integer): PPage;
    function Insert(const P: PPage; const Index: Integer; const DataPage, Child: PPage): PPage;
    function InsertItem(const P: PPage; const Index: Integer; const Key: TKey; const Value: TValue): PPage;
    function MoveNext(var Iterator: TIterator): Boolean;
    function MovePrev(var Iterator: TIterator): Boolean;
    function Page(const IsIndex: Boolean; const LeftmostChild: PPage = nil): PPage;
    function Seek(const Key: TKey; out P: PData; out Index: Integer): Boolean;
    procedure CheckSiblings(const Parent: PPage; const ParentIndex: Integer; out Left, Right: PPage);
    procedure Clear(const P: PPage);
    procedure Concat(const Parent, P, Right: PPage; const ParentIndex: Integer);
    procedure ConcatIndex(const Parent, P, Right: PPage; const ParentIndex: Integer);
    procedure ExtractIndex(const P: PPage; const Index: Integer);
    procedure MoveLeft(const Left, P: PPage; const N: Integer = 1);
    procedure MoveRight(const P, Right: PPage; const N: Integer = 1);
    procedure Overflow(const Parent, P: PPage; const ParentIndex, Index: Integer; const Key: TKey; const Value: TValue);
    procedure SetMap(const Key: TKey; const Value: TValue);
    procedure SplitData(const Parent, P: PPage; const ParentIndex, Index: Integer; const Key: TKey; const Value: TValue);
    procedure SplitIndex(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
    procedure Swap(var Dest: TValue; const Value: TValue; out Prev: TValue; const CanOverwrite: Boolean);
    procedure Underflow(const Parent, P: PPage; const ParentIndex: Integer);
    procedure Underflow(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
    property Root: PPage Read FRoot;
  protected
    function MissingKeyValue(const Key: TKey): TValue; virtual;
  public
    constructor Create(const AOwnObjects: Boolean = True; const AKIndex: Integer = 64; const AKData: Integer = 32);
    destructor Destroy; override;
    function Compare(const A, B: TKey): Integer; virtual; // abstract
    function Delete(const Key: TKey): Boolean;
    function Extract(const Key: TKey; out Value: TValue): Boolean;
    function Get(const Key: TKey; out Value: TValue): Boolean;
    function Put(const Key: TKey; const Value: TValue; const CanOverwrite: Boolean = True): Boolean;
    function Put(const Key: TKey; const Value: TValue; out Prev: TValue; const CanOverwrite: Boolean = True): Boolean;
    function Keys: TKeyEnumeratorProvider;
    function KeysReversed: TKeyEnumeratorProvider;
    function Values: TValueEnumeratorProvider;
    function ValuesReversed: TValueEnumeratorProvider;
    procedure Clear;
    property Count: Integer Read FCount;
    property First: TValue read GetFirst;
    property FirstKey: TKey read GetFirstKey;
    property KData: Integer Read FKData;
    property KIndex: Integer Read FKIndex;
    property Last: TValue read GetLast;
    property LastKey: TKey read GetLastKey;
    property Map[const Key: TKey]: TValue read GetMap write SetMap; default;
    property Range[const RangeFrom, RangeTo: TKey]: TValueEnumeratorProvider read GetRange;
    property OwnObjects: Boolean read FOwnObjects write FOwnObjects;
    property RangeKeys[const RangeFrom, RangeTo: TKey]: TKeyEnumeratorProvider read GetRangeKeys;
  end;

implementation

uses
  Math;

{ TheEnumerator }

function TheEnumerator.GetCurrent: TValue;
begin
  Result := FGetCurrent(FIterator);
end;

function TheEnumerator.MoveNext: Boolean;
begin
  Result := FMoveNext(FIterator);
end;

procedure TheEnumerator.Init(const InitialIterator: TIterator; const Mover: TMoveNext; const Getter: TGetCurrent);
begin
  Assert(Assigned(Mover));
  Assert(Assigned(Getter));
  FIterator := InitialIterator;
  FMoveNext := Mover;
  FGetCurrent := Getter;
end;

{ TheEnumeratorProvider }

function TheEnumeratorProvider.GetEnumerator: TProvidedEnumerator;
begin
  Result := FEnumerator;
end;

{ TheObjectVector }

function TheObjectVector.GetItems(const Index: Integer): TItem;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index];
end;

function TheObjectVector.GetCurrent(var Index: Integer): TItem;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index];
end;

function TheObjectVector.GetFirst: TItem;
begin
  Assert(Count <> 0);
  Result := FData[0];
end;

function TheObjectVector.GetLast: TItem;
begin
  Assert(Count <> 0);
  Result :=FData[Count - 1];
end;

function TheObjectVector.MoveNext(var Index: Integer): Boolean;
begin
  Inc(Index);
  Result := Index < Count;
end;

function TheObjectVector.MovePrev(var Index: Integer): Boolean;
begin
  Dec(Index);
  Result := Index >= 0;
end;

procedure TheObjectVector.SetCapacity(AValue: Integer);
begin
  Assert(AValue >= 0);
  if AValue = Capacity then
    Exit;
  if AValue < Count then
    AValue := Count;
  ReAllocMem(FData, AValue * SizeOf(FData[0]));
  FCapacity := AValue;
end;

procedure TheObjectVector.SetItems(const Index: Integer; const AValue: TItem);
begin
  Assert((Index >= 0) and (Index < Count));
  FData[Index] := AValue;
end;

procedure TheObjectVector.Sort(Left, Right: Integer; const Compare: TCompare);
var
  L, R: Integer;
  Pivot: TItem;
begin
  repeat
   L := Left;
   R := Right;
   Pivot := FData[(L + R) shr 1];
   repeat
     while Compare(Pivot, FData[L]) > 0 do
       L += 1;
     while Compare(Pivot, FData[R]) < 0 do
       R -= 1;
     if L <= R then begin
       Swap(L, R);
       L += 1;
       R -= 1;
     end;
   until L > R;
   if Left < R then
     Sort(Left, R, Compare);
   Left := L;
  until L >= Right;
end;

constructor TheObjectVector.Create(const AOwnObjects: Boolean);
begin
  inherited Create;
  OwnObjects := AOwnObjects;
end;

destructor TheObjectVector.Destroy;
begin
  Clear;
  inherited Destroy;
end;

function TheObjectVector.Add(const Item: TItem): Integer;
begin
  Result := Count;
  Inc(FCount);
  if Result >= Capacity then
    Capacity := 2 * Count;
  FData[Result] := Item;
end;

function TheObjectVector.Extract(const Index: Integer): TItem;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index];
  Dec(FCount);
  Move(FData[Index + 1], FData[Index], (Count - Index) * SizeOf(TItem));
end;

function TheObjectVector.Find(const Item: TItem; out Index: Integer): Boolean;
begin
  Index := IndexOf(Item);
  Result := Index >= 0;
end;

function TheObjectVector.GetEnumerator: TEnumerator;
begin
  Result.Init(-1, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@GetCurrent));
end;

function TheObjectVector.Has(const Item: TItem): Boolean;
begin
  Result := IndexOf(Item) >= 0;
end;

function TheObjectVector.IndexOf(const Item: TItem): Integer;
begin
  Assert(@Item = @Item); // hint off
  for Result := 0 to Count - 1 do
    if FData[Result] = Item then
      Exit;
  Result := -1;
end;

function TheObjectVector.Push(const Item: TItem): TItem;
begin
  Add(Item);
  Result := Item;
end;

function TheObjectVector.Remove(const Item: TItem): Integer;
begin
  if Find(Item, Result) then
    Delete(Result);
end;

function TheObjectVector.Reversed: TEnumeratorProvider;
begin
  Result.FEnumerator.Init(Count, @MovePrev, @GetCurrent);
end;

function TheObjectVector.SwapWith(const ItemAIndex: Integer; const ItemB: TItem): TItem;
begin
  Assert((ItemAIndex >= 0) and (ItemAIndex < Count));
  Result := FData[ItemAIndex];
  FData[ItemAIndex] := ItemB;
end;

procedure TheObjectVector.Clear;
var I: Integer;
begin
  if OwnObjects then
    for I := 0 to Count - 1 do
      FData[I].Free;
  FCount := 0;
  Capacity := 0;
end;

procedure TheObjectVector.Delete(const Index: Integer);
begin
  Extract(Index);
end;

procedure TheObjectVector.Insert(const Index: Integer; const Item: TItem);
begin
  Assert((Index >= 0) and (Index <= Count));
  if Count = Capacity then
    Capacity := 2 * (Count + 1);
  Move(FData[Index], FData[Index + 1], (Count - Index) * SizeOf(TItem));
  Inc(FCount);
  FData[Index] := Item;
end;

procedure TheObjectVector.Kill;
begin
  OwnObjects := False;
  Free;
end;

procedure TheObjectVector.Pack;
begin
  Capacity := Count;
end;

procedure TheObjectVector.Sort(const Compare: TCompare);
begin
  if Count > 1 then
    Sort(0, Count - 1, Compare);
end;

procedure TheObjectVector.Swap(const ItemAIndex, ItemBIndex: Integer);
var Item: TItem;
begin
  Assert((ItemAIndex >= 0) and (ItemAIndex < Count));
  Assert((ItemBIndex >= 0) and (ItemBIndex < Count));
  Item := FData[ItemAIndex];
  FData[ItemAIndex] := FData[ItemBIndex];
  FData[ItemBIndex] := Item;
end;

procedure TheObjectVector.Wipe;
begin
  FCount := 0;
end;

{ TheVector }

procedure TheVector.Pack;
begin
  Capacity := Count;
end;

procedure TheVector.Sort;
begin
  if Count > 1 then
    Sort(0, Count - 1);
end;

procedure TheVector.Swap(const ItemAIndex, ItemBIndex: Integer);
var Item: TItem;
begin
  Assert((ItemAIndex >= 0) and (ItemAIndex < Count));
  Assert((ItemBIndex >= 0) and (ItemBIndex < Count));
  Item := FData[ItemAIndex];
  FData[ItemAIndex] := FData[ItemBIndex];
  FData[ItemBIndex] := Item;
end;

function TheVector.GetItems(const Index: Integer): TItem;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index];
end;

function TheVector.GetCurrent(var Index: Integer): TItem;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index];
end;

function TheVector.GetFirst: TItem;
begin
  Assert(Count <> 0);
  Result := FData[0];
end;

function TheVector.GetLast: TItem;
begin
  Assert(Count <> 0);
  Result := FData[Count - 1];
end;

function TheVector.MoveNext(var Index: Integer): Boolean;
begin
  Inc(Index);
  Result := Index < Count;
end;

function TheVector.MovePrev(var Index: Integer): Boolean;
begin
  Dec(Index);
  Result := Index >= 0;
end;

procedure TheVector.SetCapacity(AValue: Integer);
begin
  Assert(AValue >= 0);
  if AValue = Capacity then
    Exit;
  if AValue < Count then
    AValue := Count;
  ReAllocMem(FData, AValue * SizeOf(FData[0]));
  FCapacity := AValue;
end;

procedure TheVector.SetItems(const Index: Integer; const AValue: TItem);
begin
  Assert((Index >= 0) and (Index < Count));
  FData[Index] := AValue;
end;

procedure TheVector.Sort(Left, Right: Integer);
var
  L, R: Integer;
  Pivot: TItem;
begin
  Assert(@Pivot = @Pivot); // hint off
  repeat
   L := Left;
   R := Right;
   Pivot := FData[(L + R) div 2];
   repeat
     while Pivot > FData[L] do
       L += 1;
     while Pivot < FData[R] do
       R -= 1;
     if L <= R then begin
       Swap(L, R);
       L += 1;
       R -= 1;
     end;
   until L > R;
   if Left < R then
     Sort(Left, R);
   Left := L;
  until L >= Right;
end;

destructor TheVector.Destroy;
begin
  Clear;
  inherited Destroy;
end;

function TheVector.Add(const Item: TItem): Integer;
begin
  Result := Count;
  Inc(FCount);
  if Result >= Capacity then
    Capacity := 2 * Count;
  Initialize(FData[Result]);
  FData[Result] := Item;
end;

function TheVector.Extract(const Index: Integer): TItem;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index];
  Dec(FCount);
  Finalize(FData[Index]);
  Move(FData[Index + 1], FData[Index], (Count - Index) * SizeOf(TItem));
end;

function TheVector.Find(const Item: TItem; out Index: Integer): Boolean;
begin
  Index := IndexOf(Item);
  Result := Index >= 0;
end;

function TheVector.GetEnumerator: TEnumerator;
begin
  Result.Init(-1, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@GetCurrent));
end;

function TheVector.Has(const Item: TItem): Boolean;
begin
  Result := IndexOf(Item) >= 0;
end;

function TheVector.IndexOf(const Item: TItem): Integer;
begin
  Assert(@Item = @Item); // hint off
  for Result := 0 to Count - 1 do
    if FData[Result] = Item then
      Exit;
  Result := -1;
end;

function TheVector.Push(const Item: TItem): TItem;
begin
  Add(Item);
  Result := Item;
end;

function TheVector.Remove(const Item: TItem): Integer;
begin
  if Find(Item, Result) then
    Delete(Result);
end;

function TheVector.Reversed: TEnumeratorProvider;
begin
  Result.FEnumerator.Init(Count, @MovePrev, @GetCurrent);
end;

function TheVector.SwapWith(const ItemAIndex: Integer; const ItemB: TItem): TItem;
begin
  Assert((ItemAIndex >= 0) and (ItemAIndex < Count));
  Result := FData[ItemAIndex];
  FData[ItemAIndex] := ItemB;
end;

procedure TheVector.Clear;
var I: Integer;
begin
  for I := 0 to Count - 1 do
    Finalize(FData[I]);
  FCount := 0;
  Capacity := 0;
end;

procedure TheVector.Delete(const Index: Integer);
begin
  Extract(Index);
end;

procedure TheVector.Insert(const Index: Integer; const Item: TItem);
begin
  Assert((Index >= 0) and (Index <= Count));
  if Count = Capacity then
    Capacity := 2 * (Count + 1);
  Move(FData[Index], FData[Index + 1], (Count - Index) * SizeOf(TItem));
  Inc(FCount);
  Initialize(FData[Index]);
  FData[Index] := Item;
end;

{ TheCmpVector }

procedure TheCmpVector.Pack;
begin
  Capacity := Count;
end;

procedure TheCmpVector.Sort;
begin
  if Count > 1 then
    Sort(0, Count - 1);
end;

procedure TheCmpVector.Swap(const ItemAIndex, ItemBIndex: Integer);
var Item: TItem;
begin
  Assert((ItemAIndex >= 0) and (ItemAIndex < Count));
  Assert((ItemBIndex >= 0) and (ItemBIndex < Count));
  if ItemAIndex = ItemBIndex then
    Exit;
  Item := FData[ItemAIndex];
  FData[ItemAIndex] := FData[ItemBIndex];
  FData[ItemBIndex] := Item;
end;

function TheCmpVector.GetItems(const Index: Integer): TItem;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index];
end;

function TheCmpVector.GetCurrent(var Index: Integer): TItem;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index];
end;

function TheCmpVector.GetFirst: TItem;
begin
  Assert(Count <> 0);
  Result := FData[0];
end;

function TheCmpVector.GetLast: TItem;
begin
  Assert(Count <> 0);
  Result := FData[Count - 1];
end;

function TheCmpVector.MoveNext(var Index: Integer): Boolean;
begin
  Inc(Index);
  Result := Index < Count;
end;

function TheCmpVector.MovePrev(var Index: Integer): Boolean;
begin
  Dec(Index);
  Result := Index >= 0;
end;

procedure TheCmpVector.SetCapacity(AValue: Integer);
begin
  Assert(AValue >= 0);
  if AValue = Capacity then
    Exit;
  if AValue < Count then
    AValue := Count;
  ReAllocMem(FData, AValue * SizeOf(FData[0]));
  FCapacity := AValue;
end;

procedure TheCmpVector.SetItems(const Index: Integer; const AValue: TItem);
begin
  Assert((Index >= 0) and (Index < Count));
  FData[Index] := AValue;
end;

procedure TheCmpVector.Sort(Left, Right: Integer);
var
  L, R: Integer;
  Pivot: TItem;
begin
  repeat
   L := Left;
   R := Right;
   Pivot := FData[(L + R) div 2];
   repeat
     while Compare(Pivot, FData[L]) > 0 do
       L += 1;
     while Compare(Pivot, FData[R]) < 0 do
       R -= 1;
     if L <= R then begin
       Swap(L, R);
       L += 1;
       R -= 1;
     end;
   until L > R;
   if Left < R then
     Sort(Left, R);
   Left := L;
  until L >= Right;
end;

destructor TheCmpVector.Destroy;
begin
  Clear;
  inherited Destroy;
end;

function TheCmpVector.Add(const Item: TItem): Integer;
begin
  Result := Count;
  Inc(FCount);
  if Result >= Capacity then
    Capacity := 2 * Count;
  Initialize(FData[Result]);
  FData[Result] := Item;
end;

function TheCmpVector.Compare(const A, B: TItem): Integer;
begin
  Result := 0; // hint off
  Assert(@A = @A); // hint off
  Assert(@B = @B); // hint off
  raise EAbstractError.Create(Format('%s.Compare', [ClassName]));
end;

function TheCmpVector.Extract(const Index: Integer): TItem;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index];
  Dec(FCount);
  Finalize(FData[Index]);
  Move(FData[Index + 1], FData[Index], (Count - Index) * SizeOf(TItem));
end;

function TheCmpVector.Find(const Item: TItem; out Index: Integer): Boolean;
begin
  Index := IndexOf(Item);
  Result := Index >= 0;
end;

function TheCmpVector.GetEnumerator: TEnumerator;
begin
  Result.Init(-1, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@GetCurrent));
end;

function TheCmpVector.Has(const Item: TItem): Boolean;
begin
  Result := IndexOf(Item) >= 0;
end;

function TheCmpVector.IndexOf(const Item: TItem): Integer;
begin
  for Result := 0 to Count - 1 do
    if Compare(FData[Result], Item) = 0 then
      Exit;
  Result := -1;
end;

function TheCmpVector.Push(const Item: TItem): TItem;
begin
  Add(Item);
  Result := Item;
end;

function TheCmpVector.Remove(const Item: TItem): Integer;
begin
  if Find(Item, Result) then
    Delete(Result);
end;

function TheCmpVector.Reversed: TEnumeratorProvider;
begin
  Result.FEnumerator.Init(Count, @MovePrev, @GetCurrent);
end;

function TheCmpVector.SwapWith(const ItemAIndex: Integer; const ItemB: TItem): TItem;
begin
  Assert((ItemAIndex >= 0) and (ItemAIndex < Count));
  Result := FData[ItemAIndex];
  FData[ItemAIndex] := ItemB;
end;

procedure TheCmpVector.Clear;
var I: Integer;
begin
  for I := 0 to Count - 1 do
    Finalize(FData[I]);
  FCount := 0;
  Capacity := 0;
end;

procedure TheCmpVector.Delete(const Index: Integer);
begin
  Extract(Index);
end;

procedure TheCmpVector.Insert(const Index: Integer; const Item: TItem);
begin
  Assert((Index >= 0) and (Index <= Count));
  if Count = Capacity then
    Capacity := 2 * (Count + 1);
  Move(FData[Index], FData[Index + 1], (Count - Index) * SizeOf(TItem));
  Inc(FCount);
  Initialize(FData[Index]);
  FData[Index] := Item;
end;

{ TheSortVector }

procedure TheSortVector.Pack;
begin
  Capacity := Count;
end;

function TheSortVector.GetItems(const Index: Integer): TItem;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index];
end;

function TheSortVector.GetCurrent(var Index: Integer): TItem;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index];
end;

function TheSortVector.GetFirst: TItem;
begin
  Assert(Count <> 0);
  Result := FData[0];
end;

function TheSortVector.GetLast: TItem;
begin
  Assert(Count <> 0);
  Result := FData[Count - 1];
end;

function TheSortVector.MoveNext(var Index: Integer): Boolean;
begin
  Inc(Index);
  Result := Index < Count;
end;

function TheSortVector.MovePrev(var Index: Integer): Boolean;
begin
  Dec(Index);
  Result := Index >= 0;
end;

procedure TheSortVector.SetCapacity(AValue: Integer);
begin
  Assert(AValue >= 0);
  if AValue = Capacity then
    Exit;
  if AValue < Count then
    AValue := Count;
  ReAllocMem(FData, AValue * SizeOf(FData[0]));
  FCapacity := AValue;
end;

destructor TheSortVector.Destroy;
begin
  Clear;
  inherited Destroy;
end;

function TheSortVector.Add(const Item: TItem): Integer;
begin
  Find(Item, Result);
  Insert(Result, Item);
end;

function TheSortVector.Extract(const Index: Integer): TItem;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index];
  Dec(FCount);
  Finalize(FData[Index]);
  Move(FData[Index + 1], FData[Index], (Count - Index) * SizeOf(TItem));
end;

function TheSortVector.Find(const Item: TItem; out Index: Integer): Boolean;
var L, H: Integer;
begin
  Assert(@Item = @Item); // hint off
  L := 0;
  H := Count - 1;
  while L <= H do begin
    Index := (L + H) shr 1;
    if Item < FData[Index] then
      H := Index - 1
    else if Item = FData[Index] then
      Exit(True)
    else
      L := Index + 1;
  end;
  Index := L;
  Result := False;
end;

function TheSortVector.GetEnumerator: TEnumerator;
begin
  Result.Init(-1, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@GetCurrent));
end;

function TheSortVector.Has(const Item: TItem): Boolean;
begin
  Result := IndexOf(Item) >= 0;
end;

function TheSortVector.IndexOf(const Item: TItem): Integer;
begin
  if not Find(Item, Result) then
    Result := -1;
end;

function TheSortVector.Push(const Item: TItem): TItem;
begin
  Add(Item);
  Result := Item;
end;

function TheSortVector.Remove(const Item: TItem): Integer;
begin
  if Find(Item, Result) then
    Delete(Result)
  else
    Result := -1;
end;

function TheSortVector.Reversed: TEnumeratorProvider;
begin
  Result.FEnumerator.Init(Count, @MovePrev, @GetCurrent);
end;

procedure TheSortVector.Clear;
var I: Integer;
begin
  for I := 0 to Count - 1 do
    Finalize(FData[I]);
  FCount := 0;
  Capacity := 0;
end;

procedure TheSortVector.Delete(const Index: Integer);
begin
  Extract(Index);
end;

procedure TheSortVector.Insert(const Index: Integer; const Item: TItem);
begin
  Assert((Index >= 0) and (Index <= Count));
  if Count = Capacity then
    Capacity := 2 * (Count + 1);
  Move(FData[Index], FData[Index + 1], (Count - Index) * SizeOf(TItem));
  Inc(FCount);
  Initialize(FData[Index]);
  FData[Index] := Item;
end;

{ TheCmpSortVector }

procedure TheCmpSortVector.Pack;
begin
  Capacity := Count;
end;

function TheCmpSortVector.GetItems(const Index: Integer): TItem;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index];
end;

function TheCmpSortVector.GetCurrent(var Index: Integer): TItem;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index];
end;

function TheCmpSortVector.GetFirst: TItem;
begin
  Assert(Count <> 0);
  Result := FData[0];
end;

function TheCmpSortVector.GetLast: TItem;
begin
  Assert(Count <> 0);
  Result := FData[Count - 1];
end;

function TheCmpSortVector.MoveNext(var Index: Integer): Boolean;
begin
  Inc(Index);
  Result := Index < Count;
end;

function TheCmpSortVector.MovePrev(var Index: Integer): Boolean;
begin
  Dec(Index);
  Result := Index >= 0;
end;

procedure TheCmpSortVector.SetCapacity(AValue: Integer);
begin
  Assert(AValue >= 0);
  if AValue = Capacity then
    Exit;
  if AValue < Count then
    AValue := Count;
  ReAllocMem(FData, AValue * SizeOf(FData[0]));
  FCapacity := AValue;
end;

destructor TheCmpSortVector.Destroy;
begin
  Clear;
  inherited Destroy;
end;

function TheCmpSortVector.Add(const Item: TItem): Integer;
begin
  Find(Item, Result);
  Insert(Result, Item);
end;

function TheCmpSortVector.Compare(const A, B: TItem): Integer;
begin
  Result := 0; // hint off
  Assert(@A = @A); // hint off
  Assert(@B = @B); // hint off
  raise EAbstractError.Create(Format('%s.Compare', [ClassName]));
end;

function TheCmpSortVector.Extract(const Index: Integer): TItem;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index];
  Dec(FCount);
  Finalize(FData[Index]);
  Move(FData[Index + 1], FData[Index], (Count - Index) * SizeOf(TItem));
end;

function TheCmpSortVector.Find(const Item: TItem; out Index: Integer): Boolean;
var L, H, Cmp: Integer;
begin
  L := 0;
  H := Count - 1;
  while L <= H do begin
    Index := (L + H) shr 1;
    Cmp := Compare(Item, FData[Index]);
    if Cmp < 0 then
      H := Index - 1
    else if Cmp = 0 then
      Exit(True)
    else
      L := Index + 1;
  end;
  Index := L;
  Result := False;
end;

function TheCmpSortVector.GetEnumerator: TEnumerator;
begin
  Result.Init(-1, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@GetCurrent));
end;

function TheCmpSortVector.Has(const Item: TItem): Boolean;
begin
  Result := IndexOf(Item) >= 0;
end;

function TheCmpSortVector.IndexOf(const Item: TItem): Integer;
begin
  if not Find(Item, Result) then
    Result := -1;
end;

function TheCmpSortVector.Push(const Item: TItem): TItem;
begin
  Add(Item);
  Result := Item;
end;

function TheCmpSortVector.Remove(const Item: TItem): Integer;
begin
  if Find(Item, Result) then
    Delete(Result)
  else
    Result := -1;
end;

function TheCmpSortVector.Reversed: TEnumeratorProvider;
begin
  Result.FEnumerator.Init(Count, @MovePrev, @GetCurrent);
end;

procedure TheCmpSortVector.Clear;
var I: Integer;
begin
  for I := 0 to Count - 1 do
    Finalize(FData[I]);
  FCount := 0;
  Capacity := 0;
end;

procedure TheCmpSortVector.Delete(const Index: Integer);
begin
  Extract(Index);
end;

procedure TheCmpSortVector.Insert(const Index: Integer; const Item: TItem);
begin
  Assert((Index >= 0) and (Index <= Count));
  if Count = Capacity then
    Capacity := 2 * (Count + 1);
  Move(FData[Index], FData[Index + 1], (Count - Index) * SizeOf(TItem));
  Inc(FCount);
  Initialize(FData[Index]);
  FData[Index] := Item;
end;

{ TheObjectSortVector }

procedure TheObjectSortVector.Pack;
begin
  Capacity := Count;
end;

procedure TheObjectSortVector.Wipe;
begin
  FCount := 0;
end;

function TheObjectSortVector.GetItems(const Index: Integer): TItem;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index];
end;

function TheObjectSortVector.GetCurrent(var Index: Integer): TItem;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index];
end;

function TheObjectSortVector.GetFirst: TItem;
begin
  Assert(Count <> 0);
  Result := FData[0];
end;

function TheObjectSortVector.GetLast: TItem;
begin
  Assert(Count <> 0);
  Result := FData[Count - 1];
end;

function TheObjectSortVector.MoveNext(var Index: Integer): Boolean;
begin
  Inc(Index);
  Result := Index < Count;
end;

function TheObjectSortVector.MovePrev(var Index: Integer): Boolean;
begin
  Dec(Index);
  Result := Index >= 0;
end;

procedure TheObjectSortVector.SetCapacity(AValue: Integer);
begin
  Assert(AValue >= 0);
  if AValue = Capacity then
    Exit;
  if AValue < Count then
    AValue := Count;
  ReAllocMem(FData, AValue * SizeOf(FData[0]));
  FCapacity := AValue;
end;

constructor TheObjectSortVector.Create(const AOwnObjects: Boolean);
begin
  inherited Create;
  OwnObjects := AOwnObjects;
end;

destructor TheObjectSortVector.Destroy;
begin
  Clear;
  inherited Destroy;
end;

function TheObjectSortVector.Add(const Item: TItem): Integer;
begin
  Find(Item, Result);
  Insert(Result, Item);
end;

function TheObjectSortVector.Compare(const A, B: TItem): Integer;
begin
  Result := 0; // hint off
  Assert(@A = @A); // hint off
  Assert(@B = @B); // hint off
  raise EAbstractError.Create(Format('%s.Compare', [ClassName]));
end;

function TheObjectSortVector.Extract(const Index: Integer): TItem;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index];
  Dec(FCount);
  Move(FData[Index + 1], FData[Index], (Count - Index) * SizeOf(TItem));
end;

function TheObjectSortVector.Find(const Item: TItem; out Index: Integer): Boolean;
var L, H, Cmp: Integer;
begin
  L := 0;
  H := Count - 1;
  while L <= H do begin
    Index := (L + H) shr 1;
    Cmp := Compare(Item, FData[Index]);
    if Cmp < 0 then
      H := Index - 1
    else if Cmp = 0 then
      Exit(True)
    else
      L := Index + 1;
  end;
  Index := L;
  Result := False;
end;

function TheObjectSortVector.GetEnumerator: TEnumerator;
begin
  Result.Init(-1, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@GetCurrent));
end;

function TheObjectSortVector.Has(const Item: TItem): Boolean;
begin
  Result := IndexOf(Item) >= 0;
end;

function TheObjectSortVector.IndexOf(const Item: TItem): Integer;
begin
  if not Find(Item, Result) then
    Result := -1;
end;

function TheObjectSortVector.Push(const Item: TItem): TItem;
begin
  Add(Item);
  Result := Item;
end;

function TheObjectSortVector.Remove(const Item: TItem): Integer;
begin
  if Find(Item, Result) then
    Delete(Result)
  else
    Result := -1;
end;

function TheObjectSortVector.Reversed: TEnumeratorProvider;
begin
  Result.FEnumerator.Init(Count, @MovePrev, @GetCurrent);
end;

procedure TheObjectSortVector.Clear;
var I: Integer;
begin
  if OwnObjects then
    for I := 0 to Count - 1 do
      FData[I].Free;
  FCount := 0;
  Capacity := 0;
end;

procedure TheObjectSortVector.Delete(const Index: Integer);
begin
  Extract(Index);
end;

procedure TheObjectSortVector.Kill;
begin
  OwnObjects := False;
  Free;
end;

procedure TheObjectSortVector.Insert(const Index: Integer; const Item: TItem);
begin
  Assert((Index >= 0) and (Index <= Count));
  if Count = Capacity then
    Capacity := 2 * (Count + 1);
  Move(FData[Index], FData[Index + 1], (Count - Index) * SizeOf(TItem));
  Inc(FCount);
  FData[Index] := Item;
end;

{ TheVectorSet }

function TheVectorSet.Extract(const Index: Integer): TItem;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index];
  Dec(FCount);
  Finalize(FData[Index]);
  Move(FData[Index + 1], FData[Index], (Count - Index) * SizeOf(TItem));
end;

function TheVectorSet.Find(const Item: TItem; out Index: Integer): Boolean;
var L, H: Integer;
begin
  Assert(@Item = @Item); // hint off
  L := 0;
  H := Count - 1;
  while L <= H do begin
    Index := (L + H) shr 1;
    if Item < FData[Index] then
      H := Index - 1
    else if Item = FData[Index] then
      Exit(True)
    else
      L := Index + 1;
  end;
  Index := L;
  Result := False;
end;

function TheVectorSet.GetFirst: TItem;
begin
  Assert(Count <> 0);
  Result := FData[0];
end;

function TheVectorSet.GetItem(const Index: Integer): TItem;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index];
end;

function TheVectorSet.GetCurrent(var Index: Integer): TItem;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index];
end;

function TheVectorSet.GetMembership(const Item: TItem): Boolean;
var Index: Integer;
begin
  Result := Find(Item, Index);
end;

function TheVectorSet.GetLast: TItem;
begin
  Assert(Count <> 0);
  Result := FData[Count - 1];
end;

procedure TheVectorSet.Insert(const Index: Integer; const Item: TItem);
begin
  Assert((Index >= 0) and (Index <= Count));
  if Count = Capacity then
    Capacity := 2 * (Count + 1);
  Move(FData[Index], FData[Index + 1], (Count - Index) * SizeOf(TItem));
  Inc(FCount);
  Initialize(FData[Index]);
  FData[Index] := Item;
end;

function TheVectorSet.MoveNext(var Index: Integer): Boolean;
begin
  Inc(Index);
  Result := Index < Count;
end;

function TheVectorSet.MovePrev(var Index: Integer): Boolean;
begin
  Dec(Index);
  Result := Index >= 0;
end;

procedure TheVectorSet.SetCapacity(AValue: Integer);
begin
  Assert(AValue >= 0);
  if AValue = Capacity then
    Exit;
  if AValue < Count then
    AValue := Count;
  ReAllocMem(FData, AValue * SizeOf(FData[0]));
  FCapacity := AValue;
end;

procedure TheVectorSet.SetMembership(const Item: TItem; const AValue: Boolean);
begin
  if AValue then
    Include(Item)
  else
    Exclude(Item);
end;

destructor TheVectorSet.Destroy;
begin
  Clear;
  inherited Destroy;
end;

function TheVectorSet.Exclude(const Item: TItem): Boolean;
var Index: Integer;
begin
  Result := Find(Item, Index);
  if Result then
    Extract(Index);
end;

function TheVectorSet.GetEnumerator: TEnumerator;
begin
  Result.Init(-1, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@GetCurrent));
end;

function TheVectorSet.Include(const Item: TItem): Boolean;
var Index: Integer;
begin
  if Find(Item, Index) then
    Exit(True);
  Insert(Index, Item);
  Result := False;
end;

function TheVectorSet.Reversed: TEnumeratorProvider;
begin
  Result.FEnumerator.Init(Count, @MovePrev, @GetCurrent);
end;

procedure TheVectorSet.Clear;
var I: Integer;
begin
  for I := 0 to Count - 1 do
    Finalize(FData[I]);
  FCount := 0;
  Capacity := 0;
end;

procedure TheVectorSet.Pack;
begin
  Capacity := Count;
end;

{ TheCmpVectorSet }

function TheCmpVectorSet.Extract(const Index: Integer): TItem;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index];
  Dec(FCount);
  Finalize(FData[Index]);
  Move(FData[Index + 1], FData[Index], (Count - Index) * SizeOf(TItem));
end;

function TheCmpVectorSet.Find(const Item: TItem; out Index: Integer): Boolean;
var L, H, Cmp: Integer;
begin
  L := 0;
  H := Count - 1;
  while L <= H do begin
    Index := (L + H) shr 1;
    Cmp := Compare(Item, FData[Index]);
    if Cmp < 0 then
      H := Index - 1
    else if Cmp = 0 then
      Exit(True)
    else
      L := Index + 1;
  end;
  Index := L;
  Result := False;
end;

function TheCmpVectorSet.GetFirst: TItem;
begin
  Assert(Count <> 0);
  Result := FData[0];
end;

function TheCmpVectorSet.GetItem(const Index: Integer): TItem;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index];
end;

function TheCmpVectorSet.GetCurrent(var Index: Integer): TItem;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index];
end;

function TheCmpVectorSet.GetMembership(const Item: TItem): Boolean;
var Index: Integer;
begin
  Result := Find(Item, Index);
end;

function TheCmpVectorSet.GetLast: TItem;
begin
  Assert(Count <> 0);
  Result := FData[Count - 1];
end;

procedure TheCmpVectorSet.Insert(const Index: Integer; const Item: TItem);
begin
  Assert((Index >= 0) and (Index <= Count));
  if Count = Capacity then
    Capacity := 2 * (Count + 1);
  Move(FData[Index], FData[Index + 1], (Count - Index) * SizeOf(TItem));
  Inc(FCount);
  Initialize(FData[Index]);
  FData[Index] := Item;
end;

function TheCmpVectorSet.MoveNext(var Index: Integer): Boolean;
begin
  Inc(Index);
  Result := Index < Count;
end;

function TheCmpVectorSet.MovePrev(var Index: Integer): Boolean;
begin
  Dec(Index);
  Result := Index >= 0;
end;

procedure TheCmpVectorSet.SetCapacity(AValue: Integer);
begin
  Assert(AValue >= 0);
  if AValue = Capacity then
    Exit;
  if AValue < Count then
    AValue := Count;
  ReAllocMem(FData, AValue * SizeOf(FData[0]));
  FCapacity := AValue;
end;

procedure TheCmpVectorSet.SetMembership(const Item: TItem; const AValue: Boolean);
begin
  if AValue then
    Include(Item)
  else
    Exclude(Item);
end;

destructor TheCmpVectorSet.Destroy;
begin
  Clear;
  inherited Destroy;
end;

function TheCmpVectorSet.Compare(const A, B: TItem): Integer;
begin
  Result := 0; // hint off
  Assert(@A = @A); // hint off
  Assert(@B = @B); // hint off
  raise EAbstractError.Create(Format('%s.Compare', [ClassName]));
end;

function TheCmpVectorSet.Exclude(const Item: TItem): Boolean;
var Index: Integer;
begin
  Result := Find(Item, Index);
  if Result then
    Extract(Index);
end;

function TheCmpVectorSet.GetEnumerator: TEnumerator;
begin
  Result.Init(-1, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@GetCurrent));
end;

function TheCmpVectorSet.Include(const Item: TItem): Boolean;
var Index: Integer;
begin
  if Find(Item, Index) then
    Exit(True);
  Insert(Index, Item);
  Result := False;
end;

function TheCmpVectorSet.Reversed: TEnumeratorProvider;
begin
  Result.FEnumerator.Init(Count, @MovePrev, @GetCurrent);
end;

procedure TheCmpVectorSet.Clear;
var I: Integer;
begin
  for I := 0 to Count - 1 do
    Finalize(FData[I]);
  FCount := 0;
  Capacity := 0;
end;

procedure TheCmpVectorSet.Pack;
begin
  Capacity := Count;
end;

{ TheObjectVectorSet }

function TheObjectVectorSet.Extract(const Index: Integer): TItem;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index];
  Dec(FCount);
  Finalize(FData[Index]);
  Move(FData[Index + 1], FData[Index], (Count - Index) * SizeOf(TItem));
end;

function TheObjectVectorSet.Find(const Item: TItem; out Index: Integer): Boolean;
var L, H, Cmp: Integer;
begin
  L := 0;
  H := Count - 1;
  while L <= H do begin
    Index := (L + H) shr 1;
    Cmp := Compare(Item, FData[Index]);
    if Cmp < 0 then
      H := Index - 1
    else if Cmp = 0 then
      Exit(True)
    else
      L := Index + 1;
  end;
  Index := L;
  Result := False;
end;

function TheObjectVectorSet.GetFirst: TItem;
begin
  Assert(Count <> 0);
  Result := FData[0];
end;

function TheObjectVectorSet.GetItem(const Index: Integer): TItem;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index];
end;

function TheObjectVectorSet.GetCurrent(var Index: Integer): TItem;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index];
end;

function TheObjectVectorSet.GetMembership(const Item: TItem): Boolean;
var Index: Integer;
begin
  Result := Find(Item, Index);
end;

function TheObjectVectorSet.GetLast: TItem;
begin
  Assert(Count <> 0);
  Result := FData[Count - 1];
end;

procedure TheObjectVectorSet.Insert(const Index: Integer; const Item: TItem);
begin
  Assert((Index >= 0) and (Index <= Count));
  if Count = Capacity then
    Capacity := 2 * (Count + 1);
  Move(FData[Index], FData[Index + 1], (Count - Index) * SizeOf(TItem));
  Inc(FCount);
  Initialize(FData[Index]);
  FData[Index] := Item;
end;

function TheObjectVectorSet.MoveNext(var Index: Integer): Boolean;
begin
  Inc(Index);
  Result := Index < Count;
end;

function TheObjectVectorSet.MovePrev(var Index: Integer): Boolean;
begin
  Dec(Index);
  Result := Index >= 0;
end;

procedure TheObjectVectorSet.SetCapacity(AValue: Integer);
begin
  Assert(AValue >= 0);
  if AValue = Capacity then
    Exit;
  if AValue < Count then
    AValue := Count;
  ReAllocMem(FData, AValue * SizeOf(FData[0]));
  FCapacity := AValue;
end;

procedure TheObjectVectorSet.SetMembership(const Item: TItem; const AValue: Boolean);
begin
  if AValue then
    Include(Item)
  else
    Exclude(Item);
end;

constructor TheObjectVectorSet.Create(const AOwnObjects: Boolean);
begin
  inherited Create;
  FOwnObjects := AOwnObjects;
end;

destructor TheObjectVectorSet.Destroy;
begin
  Clear;
  inherited Destroy;
end;

function TheObjectVectorSet.Compare(const A, B: TItem): Integer;
begin
  Result := 0; // hint off
  Assert(@A = @A); // hint off
  Assert(@B = @B); // hint off
  raise EAbstractError.Create(Format('%s.Compare', [ClassName]));
end;

function TheObjectVectorSet.Exclude(const Item: TItem): Boolean;
var Index: Integer;
begin
  Result := Find(Item, Index);
  if Result then
    Extract(Index);
end;

function TheObjectVectorSet.GetEnumerator: TEnumerator;
begin
  Result.Init(-1, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@GetCurrent));
end;

function TheObjectVectorSet.Include(const Item: TItem): Boolean;
var Index: Integer;
begin
  if Find(Item, Index) then
    Exit(True);
  Insert(Index, Item);
  Result := False;
end;

function TheObjectVectorSet.Reversed: TEnumeratorProvider;
begin
  Result.FEnumerator.Init(Count, @MovePrev, @GetCurrent);
end;

procedure TheObjectVectorSet.Clear;
var I: Integer;
begin
  if OwnObjects then
    for I := 0 to Count - 1 do
      FData[I].Free;
  FCount := 0;
  Capacity := 0;
end;

procedure TheObjectVectorSet.Kill;
begin
  OwnObjects := False;
  Free;
end;

procedure TheObjectVectorSet.Pack;
begin
  Capacity := Count;
end;

procedure TheObjectVectorSet.Wipe;
begin
  FCount := 0;
end;

{ TheVectorMap }

function TheVectorMap.Extract(const Index: Integer): TItem;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index];
  Dec(FCount);
  Finalize(FData[Index]);
  Move(FData[Index + 1], FData[Index], (Count - Index) * SizeOf(TItem));
end;

function TheVectorMap.Find(const AKey: TKey; out Index: Integer): Boolean;
var L, H: Integer;
begin
  Assert(@AKey = @AKey); // hint off
  L := 0;
  H := Count - 1;
  while L <= H do begin
    Index := (L + H) shr 1;
    if AKey < FData[Index].Key then
      H := Index - 1
    else if AKey = FData[Index].Key then
      Exit(True)
    else
      L := Index + 1;
  end;
  Index := L;
  Result := False;
end;

function TheVectorMap.GetFirst: TItem;
begin
  Assert(Count <> 0);
  Result := FData[0];
end;

function TheVectorMap.GetItem(const Index: Integer): TItem;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index];
end;

function TheVectorMap.GetMap(const AKey: TKey): TValue;
var Index: Integer;
begin
  if Find(AKey, Index) then
    Exit(FData[Index].Value);
  Result := MissingKeyValue(AKey);
end;

function TheVectorMap.GetKey(const Index: Integer): TKey;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index].Key;
end;

function TheVectorMap.GetCurrentKey(var Index: Integer): TKey;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index].Key;
end;

function TheVectorMap.GetLast: TItem;
begin
  Assert(Count <> 0);
  Result := FData[Count - 1];
end;

function TheVectorMap.GetValue(const Index: Integer): TValue;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index].Value;
end;

function TheVectorMap.GetCurrentValue(var Index: Integer): TValue;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index].Value;
end;

procedure TheVectorMap.Insert(const Index: Integer; const AKey: TKey; const AValue: TValue);
begin
  Assert((Index >= 0) and (Index <= Count));
  if Count = Capacity then
    Capacity := 2 * (Count + 1);
  Move(FData[Index], FData[Index + 1], (Count - Index) * SizeOf(TItem));
  Inc(FCount);
  Initialize(FData[Index]);
  FData[Index].Key := AKey;
  FData[Index].Value := AValue;
end;

function TheVectorMap.MoveNext(var Index: Integer): Boolean;
begin
  Inc(Index);
  Result := Index < Count;
end;

function TheVectorMap.MovePrev(var Index: Integer): Boolean;
begin
  Dec(Index);
  Result := Index >= 0;
end;

procedure TheVectorMap.SetCapacity(AValue: Integer);
begin
  Assert(AValue >= 0);
  if AValue = Capacity then
    Exit;
  if AValue < Count then
    AValue := Count;
  ReAllocMem(FData, AValue * SizeOf(FData[0]));
  FCapacity := AValue;
end;

procedure TheVectorMap.SetMap(const AKey: TKey; const AValue: TValue);
var Index: Integer;
begin
  if Find(AKey, Index) then
    FData[Index].Value := AValue
  else
    Insert(Index, AKey, AValue);
end;

function TheVectorMap.MissingKeyValue(const AKey: TKey): TValue;
begin
  Assert(@AKey = @AKey); // hint off
  Initialize(Result); // hint off
  raise EMapKeyNotFound.Create(ClassName);
end;

destructor TheVectorMap.Destroy;
begin
  Clear;
  inherited Destroy;
end;

function TheVectorMap.Has(const AKey: TKey): Boolean;
var Index: Integer;
begin
  Result := Find(AKey, Index);
end;

function TheVectorMap.IndexOf(const AKey: TKey): Integer;
begin
  if not Find(AKey, Result) then
    Result := -1;
end;

function TheVectorMap.Keys: TKeyEnumeratorProvider;
begin
  Result.FEnumerator.Init(-1, @MoveNext, @GetCurrentKey);
end;

function TheVectorMap.KeysReversed: TKeyEnumeratorProvider;
begin
  Result.FEnumerator.Init(Count, @MovePrev, @GetCurrentKey);
end;

function TheVectorMap.Remove(const AKey: TKey): Integer;
begin
  if Find(AKey, Result) then
    Delete(Result)
  else
    Result := -1;
end;

function TheVectorMap.Values: TValueEnumeratorProvider;
begin
  Result.FEnumerator.Init(-1, @MoveNext, @GetCurrentValue);
end;

function TheVectorMap.ValuesReversed: TValueEnumeratorProvider;
begin
  Result.FEnumerator.Init(Count, @MovePrev, @GetCurrentValue);
end;

procedure TheVectorMap.Clear;
var I: Integer;
begin
  for I := 0 to Count - 1 do
    Finalize(FData[I]);
  FCount := 0;
  Capacity := 0;
end;

procedure TheVectorMap.Delete(const Index: Integer);
begin
  Assert((Index >= 0) and (Index < Count));
  Extract(Index);
end;

procedure TheVectorMap.Pack;
begin
  Capacity := Count;
end;

{ TheCmpVectorMap }

function TheCmpVectorMap.Extract(const Index: Integer): TItem;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index];
  Dec(FCount);
  Finalize(FData[Index]);
  Move(FData[Index + 1], FData[Index], (Count - Index) * SizeOf(TItem));
end;

function TheCmpVectorMap.Find(const AKey: TKey; out Index: Integer): Boolean;
var L, H, Cmp: Integer;
begin
  L := 0;
  H := Count - 1;
  while L <= H do begin
    Index := (L + H) shr 1;
    Cmp := Compare(AKey, FData[Index].Key);
    if Cmp < 0 then
      H := Index - 1
    else if Cmp = 0 then
      Exit(True)
    else
      L := Index + 1;
  end;
  Index := L;
  Result := False;
end;

function TheCmpVectorMap.GetFirst: TItem;
begin
  Assert(Count <> 0);
  Result := FData[0];
end;

function TheCmpVectorMap.GetItem(const Index: Integer): TItem;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index];
end;

function TheCmpVectorMap.GetMap(const AKey: TKey): TValue;
var Index: Integer;
begin
  if Find(AKey, Index) then
    Exit(FData[Index].Value);
  Result := MissingKeyValue(AKey);
end;

function TheCmpVectorMap.GetKey(const Index: Integer): TKey;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index].Key;
end;

function TheCmpVectorMap.GetCurrentKey(var Index: Integer): TKey;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index].Key;
end;

function TheCmpVectorMap.GetLast: TItem;
begin
  Assert(Count <> 0);
  Result := FData[Count - 1];
end;

function TheCmpVectorMap.GetValue(const Index: Integer): TValue;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index].Value;
end;

function TheCmpVectorMap.GetCurrentValue(var Index: Integer): TValue;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index].Value;
end;

procedure TheCmpVectorMap.Insert(const Index: Integer; const AKey: TKey; const AValue: TValue);
begin
  Assert((Index >= 0) and (Index <= Count));
  if Count = Capacity then
    Capacity := 2 * (Count + 1);
  Move(FData[Index], FData[Index + 1], (Count - Index) * SizeOf(TItem));
  Inc(FCount);
  Initialize(FData[Index]);
  FData[Index].Key := AKey;
  FData[Index].Value := AValue;
end;

function TheCmpVectorMap.MoveNext(var Index: Integer): Boolean;
begin
  Inc(Index);
  Result := Index < Count;
end;

function TheCmpVectorMap.MovePrev(var Index: Integer): Boolean;
begin
  Dec(Index);
  Result := Index >= 0;
end;

procedure TheCmpVectorMap.SetCapacity(AValue: Integer);
begin
  Assert(AValue >= 0);
  if AValue = Capacity then
    Exit;
  if AValue < Count then
    AValue := Count;
  ReAllocMem(FData, AValue * SizeOf(FData[0]));
  FCapacity := AValue;
end;

procedure TheCmpVectorMap.SetMap(const AKey: TKey; const AValue: TValue);
var Index: Integer;
begin
  if Find(AKey, Index) then
    FData[Index].Value := AValue
  else
    Insert(Index, AKey, AValue);
end;

function TheCmpVectorMap.MissingKeyValue(const AKey: TKey): TValue;
begin
  Assert(@AKey = @AKey); // hint off
  Initialize(Result); // hint off
  raise EMapKeyNotFound.Create(ClassName);
end;

destructor TheCmpVectorMap.Destroy;
begin
  Clear;
  inherited Destroy;
end;

function TheCmpVectorMap.Compare(const A, B: TKey): Integer;
begin
  Result := 0; // hint off
  Assert(@A = @A); // hint off
  Assert(@B = @B); // hint off
  raise EAbstractError.Create(Format('%s.Compare', [ClassName]));
end;

function TheCmpVectorMap.Has(const AKey: TKey): Boolean;
var Index: Integer;
begin
  Result := Find(AKey, Index);
end;

function TheCmpVectorMap.IndexOf(const AKey: TKey): Integer;
begin
  if not Find(AKey, Result) then
    Result := -1;
end;

function TheCmpVectorMap.Keys: TKeyEnumeratorProvider;
begin
  Result.FEnumerator.Init(-1, @MoveNext, @GetCurrentKey);
end;

function TheCmpVectorMap.KeysReversed: TKeyEnumeratorProvider;
begin
  Result.FEnumerator.Init(Count, @MovePrev, @GetCurrentKey);
end;

function TheCmpVectorMap.Remove(const AKey: TKey): Integer;
begin
  if Find(AKey, Result) then
    Delete(Result)
  else
    Result := -1;
end;

function TheCmpVectorMap.Values: TValueEnumeratorProvider;
begin
  Result.FEnumerator.Init(-1, @MoveNext, @GetCurrentValue);
end;

function TheCmpVectorMap.ValuesReversed: TValueEnumeratorProvider;
begin
  Result.FEnumerator.Init(Count, @MovePrev, @GetCurrentValue);
end;

procedure TheCmpVectorMap.Clear;
var I: Integer;
begin
  for I := 0 to Count - 1 do
    Finalize(FData[I]);
  FCount := 0;
  Capacity := 0;
end;

procedure TheCmpVectorMap.Delete(const Index: Integer);
begin
  Assert((Index >= 0) and (Index < Count));
  Extract(Index);
end;

procedure TheCmpVectorMap.Pack;
begin
  Capacity := Count;
end;

{ TheObjectVectorMap }

function TheObjectVectorMap.Extract(const Index: Integer): TItem;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index];
  Dec(FCount);
  Finalize(FData[Index].Key);
  Move(FData[Index + 1], FData[Index], (Count - Index) * SizeOf(TItem));
end;

function TheObjectVectorMap.Find(const AKey: TKey; out Index: Integer): Boolean;
var L, H, Cmp: Integer;
begin
  L := 0;
  H := Count - 1;
  while L <= H do begin
    Index := (L + H) shr 1;
    Cmp := Compare(AKey, FData[Index].Key);
    if Cmp < 0 then
      H := Index - 1
    else if Cmp = 0 then
      Exit(True)
    else
      L := Index + 1;
  end;
  Index := L;
  Result := False;
end;

function TheObjectVectorMap.GetFirst: TItem;
begin
  Assert(Count <> 0);
  Result := FData[0];
end;

function TheObjectVectorMap.GetItem(const Index: Integer): TItem;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index];
end;

function TheObjectVectorMap.GetMap(const AKey: TKey): TValue;
var Index: Integer;
begin
  if Find(AKey, Index) then
    Exit(FData[Index].Value);
  Result := MissingKeyValue(AKey);
end;

function TheObjectVectorMap.GetKey(const Index: Integer): TKey;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index].Key;
end;

function TheObjectVectorMap.GetCurrentKey(var Index: Integer): TKey;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index].Key;
end;

function TheObjectVectorMap.GetLast: TItem;
begin
  Assert(Count <> 0);
  Result := FData[Count - 1];
end;

function TheObjectVectorMap.GetValue(const Index: Integer): TValue;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index].Value;
end;

function TheObjectVectorMap.GetCurrentValue(var Index: Integer): TValue;
begin
  Assert((Index >= 0) and (Index < Count));
  Result := FData[Index].Value;
end;

procedure TheObjectVectorMap.Insert(const Index: Integer; const AKey: TKey; const AValue: TValue);
begin
  Assert((Index >= 0) and (Index <= Count));
  if Count = Capacity then
    Capacity := 2 * (Count + 1);
  Move(FData[Index], FData[Index + 1], (Count - Index) * SizeOf(TItem));
  Inc(FCount);
  Initialize(FData[Index].Key);
  FData[Index].Key := AKey;
  FData[Index].Value := AValue;
end;

function TheObjectVectorMap.MoveNext(var Index: Integer): Boolean;
begin
  Inc(Index);
  Result := Index < Count;
end;

function TheObjectVectorMap.MovePrev(var Index: Integer): Boolean;
begin
  Dec(Index);
  Result := Index >= 0;
end;

procedure TheObjectVectorMap.SetCapacity(AValue: Integer);
begin
  Assert(AValue >= 0);
  if AValue = Capacity then
    Exit;
  if AValue < Count then
    AValue := Count;
  ReAllocMem(FData, AValue * SizeOf(FData[0]));
  FCapacity := AValue;
end;

procedure TheObjectVectorMap.SetMap(const AKey: TKey; const AValue: TValue);
var Index: Integer;
begin
  if Find(AKey, Index) then
    FData[Index].Value := AValue
  else
    Insert(Index, AKey, AValue);
end;

function TheObjectVectorMap.MissingKeyValue(const AKey: TKey): TValue;
begin
  Assert(@AKey = @AKey); // hint off
  Initialize(Result); // hint off
  raise EMapKeyNotFound.Create(ClassName);
end;

constructor TheObjectVectorMap.Create(const AOwnObjects: Boolean);
begin
  inherited Create;
  FOwnObjects := AOwnObjects;
end;

destructor TheObjectVectorMap.Destroy;
begin
  Clear;
  inherited Destroy;
end;

function TheObjectVectorMap.Compare(const A, B: TKey): Integer;
begin
  Result := 0; // hint off
  Assert(@A = @A); // hint off
  Assert(@B = @B); // hint off
  raise EAbstractError.Create(Format('%s.Compare', [ClassName]));
end;

function TheObjectVectorMap.Has(const AKey: TKey): Boolean;
var Index: Integer;
begin
  Result := Find(AKey, Index);
end;

function TheObjectVectorMap.IndexOf(const AKey: TKey): Integer;
begin
  if not Find(AKey, Result) then
    Result := -1;
end;

function TheObjectVectorMap.Keys: TKeyEnumeratorProvider;
begin
  Result.FEnumerator.Init(-1, @MoveNext, @GetCurrentKey);
end;

function TheObjectVectorMap.KeysReversed: TKeyEnumeratorProvider;
begin
  Result.FEnumerator.Init(Count, @MovePrev, @GetCurrentKey);
end;

function TheObjectVectorMap.Remove(const AKey: TKey): Integer;
begin
  if Find(AKey, Result) then
    Delete(Result)
  else
    Result := -1;
end;

function TheObjectVectorMap.Values: TValueEnumeratorProvider;
begin
  Result.FEnumerator.Init(-1, @MoveNext, @GetCurrentValue);
end;

function TheObjectVectorMap.ValuesReversed: TValueEnumeratorProvider;
begin
  Result.FEnumerator.Init(Count, @MovePrev, @GetCurrentValue);
end;

procedure TheObjectVectorMap.Clear;
var I: Integer;
begin
  for I := 0 to Count - 1 do begin
    Finalize(FData[I].Key);
    if OwnObjects then
      FData[I].Value.Free;
  end;
  FCount := 0;
  Capacity := 0;
end;

procedure TheObjectVectorMap.Delete(const Index: Integer);
begin
  Assert((Index >= 0) and (Index < Count));
  Extract(Index);
end;

procedure TheObjectVectorMap.Pack;
begin
  Capacity := Count;
end;

{ TheList }

destructor TheList.Destroy;
begin
  Clear;
  inherited Destroy;
end;

function TheList.InsertAfter(const After: PNode; const AItem: TItem): PNode;
begin
  Result := InsertAfter_(After, NewNode(AItem));
end;

function TheList.InsertAfter_(const After, Node: PNode): PNode;
var
  Node_: PNode_ absolute Node;
  After_: PNode_ absolute After;
begin
  if After^.Next = nil then
    FLast := Node
  else
    After_^.FNext^.FPrev := Node_;
  Node_^.FNext := After_^.FNext;
  After_^.FNext := Node_;
  Node_^.FPrev := After_;
  Inc(FCount);
  Result := Node;
end;

function TheList.InsertBack(const Node: PNode): PNode;
var Node_: PNode_ absolute Node;
begin
  if Last = nil then begin
    FFirst := Node;
    FLast := Node;
    Node_^.FPrev := nil;
    Node_^.FNext := nil;
    FCount := 1;
    Exit(Node);
  end;
  Result := InsertAfter_(Last, Node);
end;

function TheList.InsertBefore(const AItem: TItem; const Before: PNode): PNode;
begin
  Result := InsertBefore_(NewNode(AItem), Before);
end;

function TheList.InsertBefore_(const Node, Before: PNode): PNode;
var
  Node_: PNode_ absolute Node;
  Before_: PNode_ absolute Before;
begin
  if Before_^.FPrev = nil then
    FFirst := Node
  else
    Before_^.FPrev^.FNext := Node_;
  Node_^.FPrev := Before_^.FPrev;
  Before_^.FPrev := Node_;
  Node_^.FNext := Before_;
  Inc(FCount);
  Result := Node;
end;

function TheList.InsertFront(const Node: PNode): PNode;
var Node_: PNode_ absolute Node;
begin
  if First = nil then begin
    FFirst := Node;
    FLast := Node;
    Node_^.FPrev := nil;
    Node_^.FNext := nil;
    FCount := 1;
    Exit(Node);
  end;
  Result := InsertBefore_(Node, First);
end;

function TheList.MoveToBack(const Node: PNode): PNode;
begin
  Result := InsertBack(Extract(Node));
end;

function TheList.MoveToFront(const Node: PNode): PNode;
begin
  Result := InsertFront(Extract(Node));
end;

function TheList.NewNode(const AItem: TItem): PNode;
var Node_: PNode_ absolute Result;
begin
  New(Result);
  Node_^.FPrev := nil;
  Node_^.FNext := nil;
  Result^.Item := AItem;
end;

function TheList.PushBack(const AItem: TItem): PNode;
begin
  Result := InsertBack(NewNode(AItem));
end;

function TheList.PushFront(const AItem: TItem): PNode;
begin
  Result := InsertFront(NewNode(AItem));
end;

function TheList.Extract(const Node: PNode): PNode;
var Node_: PNode_ absolute Node;
begin
  if Node^.Prev = nil then
    FFirst := Node^.Next
  else
    Node_^.FPrev^.FNext := Node_^.FNext;
  if Node^.Next = nil then
    FLast := Node^.Prev
  else
    Node_^.FNext^.FPrev := Node_^.FPrev;
  Node_^.FPrev := nil;
  Node_^.FNext := nil;
  Dec(FCount);
  Result := Node;
end;

function TheList.NewIterator: TIterator;
begin
  Result.List := Self;
  Result.Node := nil;
end;

function TheList.GetEnumerator: TEnumerator;
begin
  Result.Init(NewIterator, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@CurrentItem));
end;

function TheList.CurrentItem(var Iterator: TIterator): TItem;
begin
  Result := Iterator.Node^.Item;
end;

function TheList.MoveNext(var Iterator: TIterator): Boolean;
begin
  if Iterator.Node <> nil then begin
    Iterator.Node := Iterator.Node^.Next;
    if Iterator.Node <> nil then
      Exit(True);
    Iterator.List := nil;
    Exit(False);
  end;
  if Iterator.List <> nil then
    Iterator.Node := PNode(TheList(Iterator.List).First);
  Result := Iterator.Node <> nil;
end;

function TheList.MovePrev(var Iterator: TIterator): Boolean;
begin
  if Iterator.Node <> nil then begin
    Iterator.Node := Iterator.Node^.Prev;
    if Iterator.Node <> nil then
      Exit(True);
    Iterator.List := nil;
    Exit(False);
  end;
  if Iterator.List <> nil then
    Iterator.Node := PNode(TheList(Iterator.List).Last);
  Result := Iterator.Node <> nil;
end;

function TheList.Reversed: TEnumeratorProvider;
begin
  Result.FEnumerator.Init(NewIterator, @MovePrev, @CurrentItem);
end;

function TheList.MoveAfter(const After, Node: PNode): PNode;
begin
  Assert(After <> Node);
  Result := InsertAfter_(After, Extract(Node));
end;

function TheList.MoveBefore(const Node, Before: PNode): PNode;
begin
  Assert(Node <> Before);
  Result := InsertBefore_(Extract(Node), Before);
end;

procedure TheList.Remove(Node: PNode);
begin
  Extract(Node);
  Dispose(Node);
end;

procedure TheList.Clear;
var Node, Next: PNode;
begin
  Node := First;
  while Node <> nil do begin
    Next := Node^.Next;
    Dispose(Node);
    Node := Next;
  end;
  FFirst := nil;
  FLast := nil;
  FCount := 0;
end;

{ TheObjectList }

destructor TheObjectList.Destroy;
begin
  Clear;
  inherited Destroy;
end;

function TheObjectList.InsertAfter(const After: PNode; const AItem: TItem): PNode;
begin
  Result := InsertAfter_(After, NewNode(AItem));
end;

function TheObjectList.InsertAfter_(const After, Node: PNode): PNode;
var
  Node_: PNode_ absolute Node;
  After_: PNode_ absolute After;
begin
  if After^.Next = nil then
    FLast := Node
  else
    After_^.FNext^.FPrev := Node_;
  Node_^.FNext := After_^.FNext;
  After_^.FNext := Node_;
  Node_^.FPrev := After_;
  Inc(FCount);
  Result := Node;
end;

function TheObjectList.InsertBack(const Node: PNode): PNode;
var Node_: PNode_ absolute Node;
begin
  if Last = nil then begin
    FFirst := Node;
    FLast := Node;
    Node_^.FPrev := nil;
    Node_^.FNext := nil;
    FCount := 1;
    Exit(Node);
  end;
  Result := InsertAfter_(Last, Node);
end;

function TheObjectList.InsertBefore(const AItem: TItem; const Before: PNode): PNode;
begin
  Result := InsertBefore_(NewNode(AItem), Before);
end;

function TheObjectList.InsertBefore_(const Node, Before: PNode): PNode;
var
  Node_: PNode_ absolute Node;
  Before_: PNode_ absolute Before;
begin
  if Before_^.FPrev = nil then
    FFirst := Node
  else
    Before_^.FPrev^.FNext := Node_;
  Node_^.FPrev := Before_^.FPrev;
  Before_^.FPrev := Node_;
  Node_^.FNext := Before_;
  Inc(FCount);
  Result := Node;
end;

function TheObjectList.InsertFront(const Node: PNode): PNode;
var Node_: PNode_ absolute Node;
begin
  if First = nil then begin
    FFirst := Node;
    FLast := Node;
    Node_^.FPrev := nil;
    Node_^.FNext := nil;
    FCount := 1;
    Exit(Node);
  end;
  Result := InsertBefore_(Node, First);
end;

function TheObjectList.MoveToBack(const Node: PNode): PNode;
begin
  Result := InsertBack(Extract(Node));
end;

function TheObjectList.MoveToFront(const Node: PNode): PNode;
begin
  Result := InsertFront(Extract(Node));
end;

function TheObjectList.NewNode(const AItem: TItem): PNode;
var Node_: PNode_ absolute Result;
begin
  New(Result);
  Node_^.FPrev := nil;
  Node_^.FNext := nil;
  Result^.Item := AItem;
end;

function TheObjectList.PushBack(const AItem: TItem): PNode;
begin
  Result := InsertBack(NewNode(AItem));
end;

function TheObjectList.PushFront(const AItem: TItem): PNode;
begin
  Result := InsertFront(NewNode(AItem));
end;

function TheObjectList.Extract(const Node: PNode): PNode;
var Node_: PNode_ absolute Node;
begin
  if Node^.Prev = nil then
    FFirst := Node^.Next
  else
    Node_^.FPrev^.FNext := Node_^.FNext;
  if Node^.Next = nil then
    FLast := Node^.Prev
  else
    Node_^.FNext^.FPrev := Node_^.FPrev;
  Node_^.FPrev := nil;
  Node_^.FNext := nil;
  Dec(FCount);
  Result := Node;
end;

function TheObjectList.NewIterator: TIterator;
begin
  Result.List := Self;
  Result.Node := nil;
end;

function TheObjectList.GetEnumerator: TEnumerator;
begin
  Result.Init(NewIterator, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@CurrentItem));
end;

function TheObjectList.CurrentItem(var Iterator: TIterator): TItem;
begin
  Result := Iterator.Node^.Item;
end;

function TheObjectList.MoveNext(var Iterator: TIterator): Boolean;
begin
  if Iterator.Node <> nil then begin
    Iterator.Node := Iterator.Node^.Next;
    if Iterator.Node <> nil then
      Exit(True);
    Iterator.List := nil;
    Exit(False);
  end;
  if Iterator.List <> nil then
    Iterator.Node := PNode(TheObjectList(Iterator.List).First);
  Result := Iterator.Node <> nil;
end;

function TheObjectList.MovePrev(var Iterator: TIterator): Boolean;
begin
  if Iterator.Node <> nil then begin
    Iterator.Node := Iterator.Node^.Prev;
    if Iterator.Node <> nil then
      Exit(True);
    Iterator.List := nil;
    Exit(False);
  end;
  if Iterator.List <> nil then
    Iterator.Node := PNode(TheObjectList(Iterator.List).Last);
  Result := Iterator.Node <> nil;
end;

function TheObjectList.Reversed: TEnumeratorProvider;
begin
  Result.FEnumerator.Init(NewIterator, @MovePrev, @CurrentItem);
end;

function TheObjectList.MoveAfter(const After, Node: PNode): PNode;
begin
  Assert(After <> Node);
  Result := InsertAfter_(After, Extract(Node));
end;

function TheObjectList.MoveBefore(const Node, Before: PNode): PNode;
begin
  Assert(Node <> Before);
  Result := InsertBefore_(Extract(Node), Before);
end;

procedure TheObjectList.Remove(Node: PNode);
begin
  Extract(Node);
  if OwnObjects then
    Node^.Item.Free;
  Dispose(Node);
end;

constructor TheObjectList.Create(const AOwnObjects: Boolean);
begin
  inherited Create;
  FOwnObjects := AOwnObjects;
end;

procedure TheObjectList.Clear;
var Node, Next: PNode;
begin
  Node := First;
  while Node <> nil do begin
    if OwnObjects then
      Node^.Item.Free;
    Next := Node^.Next;
    Dispose(Node);
    Node := Next;
  end;
  FFirst := nil;
  FLast := nil;
  FCount := 0;
end;

// BTrees section, keep last ===================================================

{$R- do not remove, required for BTrees implementation}

{ TheBTreeSet }

procedure TheBTreeSet.CheckSiblings(const Parent: PPage; const ParentIndex: Integer; out Left, Right: PPage);
begin
  Left := nil;
  Right := nil;
  if ParentIndex >= 0 then begin
    if ParentIndex > 0 then
      Left := PIndex(Parent)^.Index[ParentIndex - 1].Child;
    if ParentIndex < Parent^.Count then
      Right := PIndex(Parent)^.Index[ParentIndex + 1].Child;
  end;
end;

procedure TheBTreeSet.Clear;
begin
  if Root <> nil then begin
    Clear(Root);
    FCount := 0;
    FFirst := nil;
    FLast := nil;
    FRoot  := nil;
  end;
end;

procedure TheBTreeSet.Clear(const P: PPage);
var I: Integer;
begin
  if P^.IsIndex then
    for I := 0 to P^.Count do // Count=n Ch0 Med0 ... Chn-1 Medn-1 Chn
      Clear(PIndex(P)^.Index[I].Child)
  else
    for I := 0 to P^.Count - 1 do
      Finalize(PData(P)^.Data[I]);
  FreeMem(P);
end;

procedure TheBTreeSet.Concat(const Parent, P, Right: PPage; const ParentIndex: Integer);
begin
  MoveLeft(P, Right, Right^.Count);
  if PData(Right)^.Next <> nil then
    PData(Right)^.Next^.Prev := PData(P)
  else
    FLast := P;
  PData(P)^.Next := PData(Right)^.Next;
  FreeMem(Right);
  if Parent^.Count > 1 then begin
    ExtractIndex(Parent, ParentIndex);
    PIndex(Parent)^.Index[ParentIndex].Child := P;
  end else begin
    FreeMem(Root);
    FRoot := P;
  end;
end;

procedure TheBTreeSet.ConcatIndex(const Parent, P, Right: PPage; const ParentIndex: Integer);
begin
  PIndex(P)^.Index[P^.Count].DataPage := PIndex(Parent)^.Index[ParentIndex].DataPage;
  Move(PIndex(Right)^.Index[0], PIndex(P)^.Index[P^.Count + 1], (2 * Right^.Count + 1) * SizeOf(Pointer));
  P^.Count += Right^.Count + 1;
  FreeMem(Right);
  if Parent^.Count > 1 then begin
    Parent^.Count -= 1;
    if ParentIndex < Parent^.Count then
      Move(
        PIndex(Parent)^.Index[ParentIndex + 1].DataPage,
        PIndex(Parent)^.Index[ParentIndex].DataPage,
        2 * (Parent^.Count - ParentIndex) * SizeOf(Pointer)
      );
  end else begin
    FreeMem(Root);
    FRoot := P;
  end;
end;

constructor TheBTreeSet.Create(const AKIndex: Integer; const AKData: Integer);
begin
  inherited Create;
  FKIndex := Max(AKIndex, 2);
  FKData := Max(AKData, 1);
end;

destructor TheBTreeSet.Destroy;
begin
  Clear;
  inherited Destroy;
end;

function TheBTreeSet.Exclude(const Item: TItem): Boolean;
var
  Parent, P, DataPage: PPage;
  Index, ParentIndex: Integer;
begin
  Result := False;
  ParentIndex := -1;
  Parent := nil;
  P := Root;
  if P <> nil then
    repeat
      Result := Find(P, Item, Index);
      if Result then // Key found
        if P^.IsIndex then begin
          DataPage := PPage(PIndex(P)^.Index[Index].DataPage);
          if DataPage^.Count > KData then
            ExtractData(DataPage, 0)
          else begin
            if (P^.Count < KIndex) and (P <> Root) then
              Underflow(Parent, P, ParentIndex, Index);
            ParentIndex := Index + 1;
            Parent := P;
            P := PIndex(P)^.Index[ParentIndex].Child;
            Result := False;
          end;
        end else begin
          ExtractData(P, Index);
          if P^.Count < KData then
            if P <> Root then
              Underflow(Parent, P, ParentIndex)
            else if Count = 0 then
              Clear;
        end
      else if P^.IsIndex then begin
        if (P^.Count < KIndex) and (P <> Root) then
          Underflow(Parent, P, ParentIndex, Index);
        ParentIndex := Index;
        Parent := P;
        P := PIndex(P)^.Index[Index].Child;
      end else
        break; // give up
    until Result
end;

function TheBTreeSet.GetEnumerator: TEnumerator;
var Iterator: TIterator;
begin
  Iterator.Page := PData(FFirst);
  Iterator.Index := -1;
  Iterator.UseSentinel := False;
  Assert(Iterator.Page = Iterator.Page); // hint off
  Result.Init(Iterator, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@GetCurrent));
end;

function TheBTreeSet.Include(const Item: TItem): Boolean;
var
  P, Parent: PPage;
  Index, ParentIndex: Integer;
begin
  Result := False;
  ParentIndex := -1;
  Parent := nil;
  P := Root;
  if P <> nil then
    repeat
      if Find(P, Item, Index) then // Key found
        Exit(True);

      if P^.IsIndex then begin
        if P^.Count > 2 * KIndex then
          SplitIndex(Parent, P, ParentIndex, Index);
        ParentIndex := Index;
        Parent := P;
        P := PIndex(P)^.Index[Index].Child
      end else begin
        if P^.Count < 2 * KData then // page is not full
          InsertItem(P, Index, Item)
        else // page is full
          Overflow(Parent, P, ParentIndex, Index, Item);
        Exit(False);
      end;
    until False
  else begin // tree is empty
    FRoot := InsertItem(Page(False), 0, Item);
    FFirst := Root;
    FLast := Root;
  end;
end;

function TheBTreeSet.Reversed: TEnumeratorProvider;
var Iterator: TIterator;
begin
  Iterator.Page := PData(FLast);
  Iterator.UseSentinel := False;
  if FLast <> nil then
    Iterator.Index := FLast^.Count;
  Assert(Iterator.Page = Iterator.Page); // hint off
  Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrent);
end;

function TheBTreeSet.ExtractData(const P: PPage; const Index: Integer): TItem;
begin
  Result := PData(P)^.Data[Index];
  Finalize(PData(P)^.Data[Index]);
  P^.Count -= 1;
  if Index < P^.Count then
    Move(PData(P)^.Data[Index + 1], PData(P)^.Data[Index], (P^.Count - Index) * SizeOf(PData(P)^.Data[0]));
  FCount -=1;
end;

procedure TheBTreeSet.ExtractIndex(const P: PPage; const Index: Integer);
begin
  P^.Count -= 1;
  if Index < P^.Count then
    Move(PIndex(P)^.Index[Index + 1], PIndex(P)^.Index[Index], ((P^.Count - Index) * 2 + 1) * SizeOf(Pointer));
end;

function TheBTreeSet.Find(const P: PPage; const Item: TItem; out Index: Integer): Boolean;
type PItem = ^TItem;
var
  L, H: Integer;
  MidItem: PItem;
  Mid: Integer absolute Index;
begin
  Assert(@Item = @Item); // hint off
  L := 0;
  H := P^.Count - 1;
  while L <= H do begin
    Mid := (L + H) shr 1;
    if P^.IsIndex then
      MidItem := @PIndex(P)^.Index[Mid].DataPage^.Data[0]
    else
      MidItem := @PData(P)^.Data[Mid];
    if Item > MidItem^ then
      L := Mid + 1
    else if Item = MidItem^ then
      Exit(True)
    else
      H := Mid - 1;
  end;
  Index  := L;
  Result := False;
end;

function TheBTreeSet.GetFirst: TItem;
begin
  Assert(Count <> 0);
  Result := PData(FFirst)^.Data[0];
end;

function TheBTreeSet.GetLast: TItem;
begin
  Assert(Count <> 0);
  Result := PData(FLast)^.Data[FLast^.Count - 1];
end;

function TheBTreeSet.GetCurrent(var Iterator: TIterator): TItem;
begin
  Result := Iterator.Page^.Data[Iterator.Index];
end;

function TheBTreeSet.GetMembership(const Item: TItem): Boolean;
var
  P: PData;
  Index: Integer;
begin
  Result := Seek(Item, P, Index);
end;

function TheBTreeSet.GetRange(const RangeFrom, RangeTo: TItem): TEnumeratorProvider;
var Iterator: TIterator;
begin
  Iterator.UseSentinel := True;
  Iterator.Sentinel := RangeTo;

  if RangeFrom <= RangeTo then begin
    Seek(RangeFrom, Iterator.Page, Iterator.Index);
    Dec(Iterator.Index);
    Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrent);
    Exit;
  end;

  // RangeFrom > RangeTo
  if Seek(RangeFrom, Iterator.Page, Iterator.Index) and (Iterator.Index < PPage(Iterator.Page)^.Count) then
    Inc(Iterator.Index);
  Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrent);
end;

function TheBTreeSet.Insert(const P: PPage; const Index: Integer): PPage;
begin
  if Index < P^.Count then
    if P^.IsIndex then
      Move(PIndex(P)^.Index[Index].DataPage, PIndex(P)^.Index[Index + 1].DataPage, (P^.Count - Index) * 2 * SizeOf(Pointer))
    else
      Move(PData(P)^.Data[Index], PData(P)^.Data[Index + 1], (P^.Count - Index) * SizeOf(PData(P)^.Data[0]));
  Inc(P^.Count);
  Result := P;
end;

function TheBTreeSet.Insert(const P: PPage; const Index: Integer; const DataPage, Child: PPage): PPage;
begin
  Result := Insert(P, Index);
  PIndex(Result)^.Index[Index].DataPage := PData(DataPage);
  PIndex(Result)^.Index[Index + 1].Child := Child;
end;

function TheBTreeSet.InsertItem(const P: PPage; const Index: Integer; const Item: TItem): PPage;
begin
  Result := Insert(P, Index);
  Initialize(PData(P)^.Data[Index]);
  PData(P)^.Data[Index] := Item;
  Inc(FCount);
end;

function TheBTreeSet.MoveNext(var Iterator: TIterator): Boolean;
begin
  while Iterator.Page <> nil do begin
    Inc(Iterator.Index);
    if Iterator.Index < PPage(Iterator.Page)^.Count then
      Exit(not Iterator.UseSentinel or (Iterator.Page^.Data[Iterator.Index] <= Iterator.Sentinel));
    Iterator.Page := Iterator.Page^.Next;
    Iterator.Index := -1;
  end;
  Result := False;
end;

function TheBTreeSet.MovePrev(var Iterator: TIterator): Boolean;
begin
  while Iterator.Page <> nil do begin
    Dec(Iterator.Index);
    if Iterator.Index >= 0 then
      Exit(not Iterator.UseSentinel or (Iterator.Page^.Data[Iterator.Index] >= Iterator.Sentinel));
    Iterator.Page := Iterator.Page^.Prev;
    if Iterator.Page <> nil then
      Iterator.Index := PPage(Iterator.Page)^.Count;
  end;
  Result := False;
end;

procedure TheBTreeSet.MoveLeft(const Left, P: PPage; const N: Integer);
begin
  Move(PData(P)^.Data[0], PData(Left)^.Data[Left^.Count], N * SizeOf(PData(P)^.Data[0]));
  Move(PData(P)^.Data[N], PData(P)^.Data[0], (P^.Count - N) * SizeOf(PData(P)^.Data[0]));
  Left^.Count += N;
  P^.Count -= N;
end;

procedure TheBTreeSet.MoveRight(const P, Right: PPage; const N: Integer);
begin
  Move(PData(Right)^.Data[0], PData(Right)^.Data[N], Right^.Count * SizeOf(PData(P)^.Data[0]));
  Move(PData(P)^.Data[P^.Count - N], PData(Right)^.Data[0], N * SizeOf(PData(P)^.Data[0]));
  Right^.Count += N;
  P^.Count -= N;
end;

procedure TheBTreeSet.Overflow(const Parent, P: PPage; const ParentIndex, Index: Integer; const Item: TItem);
var Left, Right: PPage;
begin
  CheckSiblings(Parent, ParentIndex, Left, Right);

  if (Left <> nil) and (Left^.Count < 2 * KData) then begin
    MoveLeft(Left, P);
    InsertItem(P, Index - 1, Item);
    Exit;
  end;

  if (Right <> nil) and (Right^.Count < 2 * KData) then begin
    if Index < 2 * KData then begin
      MoveRight(P, Right);
      InsertItem(P, Index, Item)
    end else
      InsertItem(Right, 0, Item);
    Exit;
  end;

  SplitData(Parent, P, ParentIndex, Index, Item);
end;

procedure TheBTreeSet.SetMembership(const Item: TItem; const AValue: Boolean);
begin
  if AValue then
    Include(Item)
  else
    Exclude(Item);
end;

function TheBTreeSet.Page(const IsIndex: Boolean; const LeftmostChild: PPage): PPage;
begin
  if IsIndex then begin
    GetMem(Result, SizeOf(TPage.Count) + SizeOf(TPage.IsIndex) + (4 * KIndex + 3) * SizeOf(Pointer));
    PIndex(Result)^.Index[0].Child := LeftmostChild;
  end else begin
    GetMem(Result, SizeOf(TPage.Count) + SizeOf(TPage.IsIndex) + 2 * SizeOf(Pointer) +  2 * KData * SizeOf(TDataPage.Data[0]));
    PData(Result)^.Prev := nil;
    PData(Result)^.Next := nil;
  end;
  Result^.IsIndex := IsIndex;
  Result^.Count := 0;
end;

function TheBTreeSet.Seek(const Item: TItem; out P: PData; out Index: Integer): Boolean;
begin
  Result := False;
  P := PData(Root);
  if P <> nil then begin // tree is non empty
    repeat
      Result := Find(PPage(P), Item, Index);
      if Result then begin // Key found
        if PPage(P)^.IsIndex then begin
          P := PIndex(P)^.Index[Index].DataPage;
          Index := 0;
        end;
      end else if PPage(P)^.IsIndex then
        P := PData(PIndex(P)^.Index[Index].Child)
      else
        break;
    until Result;
  end;
end;

procedure TheBTreeSet.SplitData(const Parent, P: PPage; const ParentIndex, Index: Integer; const Item: TItem);
var Right: PPage;
begin
  Right := Page(False);
  if PData(P)^.Next <> nil then begin // P was not last
    PData(Right)^.Next := PData(P)^.Next;
    PData(Right)^.Next^.Prev := PData(Right);
  end else  // P was last
    FLast := Right;
  PData(P)^.Next := PData(Right);
  PData(Right)^.Prev := PData(P);
  Move(PData(P)^.Data[KData], PData(Right)^.Data[0], KData * SizeOf(PData(P)^.Data[0]));
  P^.Count := KData;
  Right^.Count := KData;
  if ParentIndex >= 0 then
    Insert(Parent, ParentIndex, Right, Right)
  else
    FRoot := Insert(Page(True, P), 0, Right, Right);
  if Index > KData then
    InsertItem(Right, Index - KData, Item)
  else
    InsertItem(P, Index, Item);
end;

procedure TheBTreeSet.SplitIndex(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
var Right: PPage;
begin
  Right := Page(True);
  Move(PIndex(P)^.Index[KIndex + 1], PIndex(Right)^.Index[0], (2 * KIndex + 1) * SizeOf(Pointer));
  P^.Count := KIndex;
  Right^.Count := KIndex;
  if ParentIndex >= 0 then
    Insert(Parent, ParentIndex, PPage(PIndex(P)^.Index[KIndex].DataPage), Right)
  else
    FRoot := Insert(Page(True, P), 0, PPage(PIndex(P)^.Index[KIndex].DataPage), Right);
  if Index > KIndex then begin
    P := Right;
    Index -= KIndex + 1;
  end;
end;

procedure TheBTreeSet.Underflow(const Parent, P: PPage; const ParentIndex: Integer);
var Left, Right: PPage;
begin
  CheckSiblings(Parent, ParentIndex, Left, Right);
  if (Left <> nil) and (Left^.Count + P^.Count >= 2 * KData) then
    MoveRight(Left, P)
  else if (Right <> nil) and (P^.Count + Right^.Count >= 2 * KData) then
    MoveLeft(P, Right)
  else if Left <> nil then
    Concat(Parent, Left, P, ParentIndex - 1)
  else
    Concat(Parent, P, Right, ParentIndex);
end;

procedure TheBTreeSet.Underflow(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
var Left, Right: PPage;
begin
  CheckSiblings(Parent, ParentIndex, Left, Right);

  if (Left <> nil) and (Left^.Count > KIndex) then begin
    Move(PIndex(P)^.Index[0], PIndex(P)^.Index[1], (2 * P^.Count + 1) * SizeOf(Pointer));
    PIndex(P)^.Index[0].Child := PIndex(Left)^.Index[Left^.Count].Child;
    PIndex(P)^.Index[0].DataPage := PIndex(Parent)^.Index[ParentIndex - 1].DataPage;
    P^.Count += 1;
    Index += 1;
    Left^.Count -= 1;
    PIndex(Parent)^.Index[ParentIndex - 1].DataPage := PIndex(Left)^.Index[Left^.Count].DataPage;
    Exit;
  end;

  if (Right <> nil) and (Right^.Count > KIndex) then begin
    PIndex(P)^.Index[P^.Count].DataPage := PIndex(Parent)^.Index[ParentIndex].DataPage;
    P^.Count += 1;
    PIndex(P)^.Index[P^.Count].Child := PIndex(Right)^.Index[0].Child;
    PIndex(Parent)^.Index[ParentIndex].DataPage := PIndex(Right)^.Index[0].DataPage;
    Move(PIndex(Right)^.Index[1], PIndex(Right)^.Index[0], (2 * Right^.Count + 1) * SizeOf(Pointer));
    Right^.Count -= 1;
    Exit;
  end;

  if Left <> nil then begin
    Index += Left^.Count + 1;
    ConcatIndex(Parent, Left, P, ParentIndex - 1);
    P := Left;
    Exit;
  end;

  ConcatIndex(Parent, P, Right, ParentIndex);
end;

{ TheBTreeMap }

procedure TheBTreeMap.CheckSiblings(const Parent: PPage; const ParentIndex: Integer; out Left, Right: PPage);
begin
  Left := nil;
  Right := nil;
  if ParentIndex >= 0 then begin
    if ParentIndex > 0 then
      Left := PIndex(Parent)^.Index[ParentIndex - 1].Child;
    if ParentIndex < Parent^.Count then
      Right := PIndex(Parent)^.Index[ParentIndex + 1].Child;
  end;
end;

procedure TheBTreeMap.Clear;
begin
  if Root <> nil then begin
    Clear(Root);
    FCount := 0;
    FFirst := nil;
    FLast := nil;
    FRoot  := nil;
  end;
end;

procedure TheBTreeMap.Clear(const P: PPage);
var I: Integer;
begin
  if P^.IsIndex then
    for I := 0 to P^.Count do // Count=n Ch0 Med0 ... Chn-1 Medn-1 Chn
      Clear(PIndex(P)^.Index[I].Child)
  else
    for I := 0 to P^.Count - 1 do
      Finalize(PData(P)^.Data[I]);
  FreeMem(P);
end;

procedure TheBTreeMap.Concat(const Parent, P, Right: PPage; const ParentIndex: Integer);
begin
  MoveLeft(P, Right, Right^.Count);
  if PData(Right)^.Next <> nil then
    PData(Right)^.Next^.Prev := PData(P)
  else
    FLast := P;
  PData(P)^.Next := PData(Right)^.Next;
  FreeMem(Right);
  if Parent^.Count > 1 then begin
    ExtractIndex(Parent, ParentIndex);
    PIndex(Parent)^.Index[ParentIndex].Child := P;
  end else begin
    FreeMem(Root);
    FRoot := P;
  end;
end;

procedure TheBTreeMap.ConcatIndex(const Parent, P, Right: PPage; const ParentIndex: Integer);
begin
  PIndex(P)^.Index[P^.Count].DataPage := PIndex(Parent)^.Index[ParentIndex].DataPage;
  Move(PIndex(Right)^.Index[0], PIndex(P)^.Index[P^.Count + 1], (2 * Right^.Count + 1) * SizeOf(Pointer));
  P^.Count += Right^.Count + 1;
  FreeMem(Right);
  if Parent^.Count > 1 then begin
    Parent^.Count -= 1;
    if ParentIndex < Parent^.Count then
      Move(
        PIndex(Parent)^.Index[ParentIndex + 1].DataPage,
        PIndex(Parent)^.Index[ParentIndex].DataPage,
        2 * (Parent^.Count - ParentIndex) * SizeOf(Pointer)
      );
  end else begin
    FreeMem(Root);
    FRoot := P;
  end;
end;

constructor TheBTreeMap.Create(const AKIndex: Integer; const AKData: Integer);
begin
  inherited Create;
  FKIndex := Max(AKIndex, 2);
  FKData := Max(AKData, 1);
end;

function TheBTreeMap.Delete(const Key: TKey): Boolean;
var Dummy: TValue;
begin
  Result := Extract(Key, Dummy);
end;

destructor TheBTreeMap.Destroy;
begin
  Clear;
  inherited Destroy;
end;

function TheBTreeMap.ExtractData(const P: PPage; const Index: Integer): TValue;
begin
  Result := PData(P)^.Data[Index].Value;
  Finalize(PData(P)^.Data[Index]);
  P^.Count -= 1;
  if Index < P^.Count then
    Move(PData(P)^.Data[Index + 1], PData(P)^.Data[Index], (P^.Count - Index) * SizeOf(PData(P)^.Data[0]));
  FCount -=1;
end;

procedure TheBTreeMap.ExtractIndex(const P: PPage; const Index: Integer);
begin
  P^.Count -= 1;
  if Index < P^.Count then
    Move(PIndex(P)^.Index[Index + 1], PIndex(P)^.Index[Index], ((P^.Count - Index) * 2 + 1) * SizeOf(Pointer));
end;

function TheBTreeMap.Extract(const Key: TKey; out Value: TValue): Boolean;
var
  Parent, P, DataPage: PPage;
  Index, ParentIndex: Integer;
begin
  Result := False;
  ParentIndex := -1;
  Parent := nil;
  P := Root;
  if P <> nil then
    repeat
      Result := Find(P, Key, Index);
      if Result then // Key found
        if P^.IsIndex then begin
          DataPage := PPage(PIndex(P)^.Index[Index].DataPage);
          if DataPage^.Count > KData then
            Value := ExtractData(DataPage, 0)
          else begin
            if (P^.Count < KIndex) and (P <> Root) then
              Underflow(Parent, P, ParentIndex, Index);
            ParentIndex := Index + 1;
            Parent := P;
            P := PIndex(P)^.Index[ParentIndex].Child;
            Result := False;
          end;
        end else begin
          Value := ExtractData(P, Index);
          if P^.Count < KData then
            if P <> Root then
              Underflow(Parent, P, ParentIndex)
            else if Count = 0 then
              Clear;
        end
      else if P^.IsIndex then begin
        if (P^.Count < KIndex) and (P <> Root) then
          Underflow(Parent, P, ParentIndex, Index);
        ParentIndex := Index;
        Parent := P;
        P := PIndex(P)^.Index[Index].Child;
      end else
        break; // give up
    until Result
end;

function TheBTreeMap.Find(const P: PPage; const Key: TKey; out Index: Integer): Boolean;
type PKey = ^TKey;
var
  L, H: Integer;
  MidKey: PKey;
  Mid: Integer absolute Index;
begin
  Assert(@Key = @Key); // hint offf
  L := 0;
  H := P^.Count - 1;
  while L <= H do begin
    Mid := (L + H) shr 1;
    if P^.IsIndex then
      MidKey := @PIndex(P)^.Index[Mid].DataPage^.Data[0].Key
    else
      MidKey := @PData(P)^.Data[Mid].Key;
    if Key > MidKey^ then
      L := Mid + 1
    else if Key = MidKey^ then
      Exit(True)
    else
      H := Mid - 1;
  end;
  Index  := L;
  Result := False;
end;

function TheBTreeMap.GetCurrent(var Iterator: TIterator): TValue;
begin
  Result := Iterator.Page^.Data[Iterator.Index].Value;
end;

function TheBTreeMap.GetCurrentKey(var Iterator: TIterator): TKey;
begin
  Result := Iterator.Page^.Data[Iterator.Index].Key;
end;

function TheBTreeMap.GetFirst: TValue;
begin
  Assert(Count <> 0);
  Result := PData(FFirst)^.Data[0].Value;
end;

function TheBTreeMap.GetFirstKey: TKey;
begin
  Assert(Count <> 0);
  Result := PData(FFirst)^.Data[0].Key;
end;

function TheBTreeMap.GetLast: TValue;
begin
  Assert(Count <> 0);
  Result := PData(FLast)^.Data[FLast^.Count - 1].Value;
end;

function TheBTreeMap.GetLastKey: TKey;
begin
  Assert(Count <> 0);
  Result := PData(FLast)^.Data[FLast^.Count - 1].Key;
end;

function TheBTreeMap.GetMap(const Key: TKey): TValue;
begin
  if not Get(Key, Result) then
    Result := MissingKeyValue(Key);
end;

function TheBTreeMap.GetRange(const RangeFrom, RangeTo: TKey): TValueEnumeratorProvider;
var Iterator: TIterator;
begin
  Iterator.UseSentinel := True;
  Iterator.Sentinel := RangeTo;

  if RangeFrom <= RangeTo then begin
    Seek(RangeFrom, Iterator.Page, Iterator.Index);
    Dec(Iterator.Index);
    Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrent);
    Exit;
  end;

  // RangeFrom > RangeTo
  if Seek(RangeFrom, Iterator.Page, Iterator.Index) and (Iterator.Index < PPage(Iterator.Page)^.Count) then
    Inc(Iterator.Index);
  Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrent);
end;

function TheBTreeMap.GetRangeKeys(const RangeFrom, RangeTo: TKey): TKeyEnumeratorProvider;
var Iterator: TIterator;
begin
  Iterator.UseSentinel := True;
  Iterator.Sentinel := RangeTo;

  if RangeFrom <= RangeTo then begin
    Seek(RangeFrom, Iterator.Page, Iterator.Index);
    Dec(Iterator.Index);
    Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrentKey);
    Exit;
  end;

  // RangeFrom > RangeTo
  if Seek(RangeFrom, Iterator.Page, Iterator.Index) and (Iterator.Index < PPage(Iterator.Page)^.Count) then
    Inc(Iterator.Index);
  Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrentKey);
end;

function TheBTreeMap.Get(const Key: TKey; out Value: TValue): Boolean;
var
  P: PPage;
  Index: Integer;
begin
  Result := False;
  P := Root;
  if P <> nil then // tree is non empty
    repeat
      Result := Find(P, Key, Index);
      if Result then // Key found
        if P^.IsIndex then
          Value := PIndex(P)^.Index[Index].DataPage^.Data[0].Value
        else
          Value := PData(P)^.Data[Index].Value
      else if P^.IsIndex then
        P := PIndex(P)^.Index[Index].Child
      else
        break; // give up
    until Result;
end;

function TheBTreeMap.Insert(const P: PPage; const Index: Integer): PPage;
begin
  if Index < P^.Count then
    if P^.IsIndex then
      Move(PIndex(P)^.Index[Index].DataPage, PIndex(P)^.Index[Index + 1].DataPage, (P^.Count - Index) * 2 * SizeOf(Pointer))
    else
      Move(PData(P)^.Data[Index], PData(P)^.Data[Index + 1], (P^.Count - Index) * SizeOf(PData(P)^.Data[0]));
  Inc(P^.Count);
  Result := P;
end;

function TheBTreeMap.Insert(const P: PPage; const Index: Integer; const DataPage, Child: PPage): PPage;
begin
  Result := Insert(P, Index);
  PIndex(Result)^.Index[Index].DataPage := PData(DataPage);
  PIndex(Result)^.Index[Index + 1].Child := Child;
end;

function TheBTreeMap.InsertItem(const P: PPage; const Index: Integer; const Key: TKey; const Value: TValue): PPage;
begin
  Result := Insert(P, Index);
  Initialize(PData(P)^.Data[Index]);
  PData(P)^.Data[Index].Key := Key;
  PData(P)^.Data[Index].Value := Value;
  Inc(FCount);
end;

procedure TheBTreeMap.MoveLeft(const Left, P: PPage; const N: Integer);
begin
  Move(PData(P)^.Data[0], PData(Left)^.Data[Left^.Count], N * SizeOf(PData(P)^.Data[0]));
  Move(PData(P)^.Data[N], PData(P)^.Data[0], (P^.Count - N) * SizeOf(PData(P)^.Data[0]));
  Left^.Count += N;
  P^.Count -= N;
end;

function TheBTreeMap.MoveNext(var Iterator: TIterator): Boolean;
begin
  while Iterator.Page <> nil do begin
    Inc(Iterator.Index);
    if Iterator.Index < PPage(Iterator.Page)^.Count then
      Exit(not Iterator.UseSentinel or (Iterator.Page^.Data[Iterator.Index].Key <= Iterator.Sentinel));
    Iterator.Page := Iterator.Page^.Next;
    Iterator.Index := -1;
  end;
  Result := False;
end;

function TheBTreeMap.MovePrev(var Iterator: TIterator): Boolean;
begin
  while Iterator.Page <> nil do begin
    Dec(Iterator.Index);
    if Iterator.Index >= 0 then
      Exit(not Iterator.UseSentinel or (Iterator.Page^.Data[Iterator.Index].Key >= Iterator.Sentinel));
    Iterator.Page := Iterator.Page^.Prev;
    if Iterator.Page <> nil then
      Iterator.Index := PPage(Iterator.Page)^.Count;
  end;
  Result := False;
end;

procedure TheBTreeMap.MoveRight(const P, Right: PPage; const N: Integer);
begin
  Move(PData(Right)^.Data[0], PData(Right)^.Data[N], Right^.Count * SizeOf(PData(P)^.Data[0]));
  Move(PData(P)^.Data[P^.Count - N], PData(Right)^.Data[0], N * SizeOf(PData(P)^.Data[0]));
  Right^.Count += N;
  P^.Count -= N;
end;

procedure TheBTreeMap.Overflow(const Parent, P: PPage; const ParentIndex, Index: Integer; const Key: TKey; const Value: TValue);
var Left, Right: PPage;
begin
  CheckSiblings(Parent, ParentIndex, Left, Right);

  if (Left <> nil) and (Left^.Count < 2 * KData) then begin
    MoveLeft(Left, P);
    InsertItem(P, Index - 1, Key, Value);
    Exit;
  end;

  if (Right <> nil) and (Right^.Count < 2 * KData) then begin
    if Index < 2 * KData then begin
      MoveRight(P, Right);
      InsertItem(P, Index, Key, Value)
    end else
      InsertItem(Right, 0, Key, Value);
    Exit;
  end;

  SplitData(Parent, P, ParentIndex, Index, Key, Value);
end;

procedure TheBTreeMap.SetMap(const Key: TKey; const Value: TValue);
begin
  Put(Key, Value);
end;

function TheBTreeMap.Page(const IsIndex: Boolean; const LeftmostChild: PPage): PPage;
begin
  if IsIndex then begin
    GetMem(Result, SizeOf(TPage.Count) + SizeOf(TPage.IsIndex) + (4 * KIndex + 3) * SizeOf(Pointer));
    PIndex(Result)^.Index[0].Child := LeftmostChild;
  end else begin
    GetMem(Result, SizeOf(TPage.Count) + SizeOf(TPage.IsIndex) + 2 * SizeOf(Pointer) +  2 * KData * SizeOf(TDataPage.Data[0]));
    PData(Result)^.Prev := nil;
    PData(Result)^.Next := nil;
  end;
  Result^.IsIndex := IsIndex;
  Result^.Count := 0;
end;

function TheBTreeMap.Seek(const Key: TKey; out P: PData; out Index: Integer): Boolean;
begin
  Result := False;
  P := PData(Root);
  if P <> nil then begin // tree is non empty
    repeat
      Result := Find(PPage(P), Key, Index);
      if Result then begin // Key found
        if PPage(P)^.IsIndex then begin
          P := PIndex(P)^.Index[Index].DataPage;
          Index := 0;
        end;
      end else if PPage(P)^.IsIndex then
        P := PData(PIndex(P)^.Index[Index].Child)
      else
        break;
    until Result;
  end;
end;

function TheBTreeMap.Put(const Key: TKey; const Value: TValue; const CanOverwrite: Boolean): Boolean;
var Dummy: TValue;
begin
  Result := Put(Key, Value, Dummy, CanOverwrite);
end;

function TheBTreeMap.Put(const Key: TKey; const Value: TValue; out Prev: TValue; const CanOverwrite: Boolean): Boolean;
var
  P, Parent: PPage;
  Index, ParentIndex: Integer;
begin
  Result := False;
  ParentIndex := -1;
  Parent := nil;
  P := Root;
  if P <> nil then
    repeat
      Result := Find(P, Key, Index);
      if Result then // Key found
        if P^.IsIndex then
          Swap(PIndex(P)^.Index[Index].DataPage^.Data[0].Value, Value, Prev, CanOverwrite)
        else
          Swap(PData(P)^.Data[Index].Value, Value, Prev, CanOverwrite)
      else if P^.IsIndex then begin
        if P^.Count > 2 * KIndex then
          SplitIndex(Parent, P, ParentIndex, Index);
        ParentIndex := Index;
        Parent := P;
        P := PIndex(P)^.Index[Index].Child
      end else begin
        if P^.Count < 2 * KData then // page is not full
          InsertItem(P, Index, Key, Value)
        else // page is full
          Overflow(Parent, P, ParentIndex, Index, Key, Value);
        break;
      end;
    until Result
  else begin // tree is empty
    FRoot := InsertItem(Page(False), 0, Key, Value);
    FFirst := Root;
    FLast := Root;
  end;
end;

function TheBTreeMap.Keys: TKeyEnumeratorProvider;
var Iterator: TIterator;
begin
  Iterator.Page := PData(FFirst);
  Iterator.Index := -1;
  Iterator.UseSentinel := False;
  Assert(Iterator.Page = Iterator.Page); // hint off
  Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrentKey);
end;

function TheBTreeMap.KeysReversed: TKeyEnumeratorProvider;
var Iterator: TIterator;
begin
  Iterator.Page := PData(FLast);
  Iterator.UseSentinel := False;
  if FLast <> nil then
    Iterator.Index := FLast^.Count;
  Assert(Iterator.Page = Iterator.Page); // hint off
  Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrentKey);
end;

function TheBTreeMap.Values: TValueEnumeratorProvider;
var Iterator: TIterator;
begin
  Iterator.Page := PData(FFirst);
  Iterator.Index := -1;
  Iterator.UseSentinel := False;
  Assert(Iterator.Page = Iterator.Page); // hint off
  Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrent);
end;

function TheBTreeMap.ValuesReversed: TValueEnumeratorProvider;
var Iterator: TIterator;
begin
  Iterator.Page := PData(FLast);
  Iterator.UseSentinel := False;
  if FLast <> nil then
    Iterator.Index := FLast^.Count;
  Assert(Iterator.Page = Iterator.Page); // hint off
  Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrent);
end;

procedure TheBTreeMap.SplitData(const Parent, P: PPage; const ParentIndex, Index: Integer; const Key: TKey; const Value: TValue);
var Right: PPage;
begin
  Right := Page(False);
  if PData(P)^.Next <> nil then begin // P was not last
    PData(Right)^.Next := PData(P)^.Next;
    PData(Right)^.Next^.Prev := PData(Right);
  end else  // P was last
    FLast := Right;
  PData(P)^.Next := PData(Right);
  PData(Right)^.Prev := PData(P);
  Move(PData(P)^.Data[KData], PData(Right)^.Data[0], KData * SizeOf(PData(P)^.Data[0]));
  P^.Count := KData;
  Right^.Count := KData;
  if ParentIndex >= 0 then
    Insert(Parent, ParentIndex, Right, Right)
  else
    FRoot := Insert(Page(True, P), 0, Right, Right);
  if Index > KData then
    InsertItem(Right, Index - KData, Key, Value)
  else
    InsertItem(P, Index, Key, Value);
end;

procedure TheBTreeMap.SplitIndex(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
var Right: PPage;
begin
  Right := Page(True);
  Move(PIndex(P)^.Index[KIndex + 1], PIndex(Right)^.Index[0], (2 * KIndex + 1) * SizeOf(Pointer));
  P^.Count := KIndex;
  Right^.Count := KIndex;
  if ParentIndex >= 0 then
    Insert(Parent, ParentIndex, PPage(PIndex(P)^.Index[KIndex].DataPage), Right)
  else
    FRoot := Insert(Page(True, P), 0, PPage(PIndex(P)^.Index[KIndex].DataPage), Right);
  if Index > KIndex then begin
    P := Right;
    Index -= KIndex + 1;
  end;
end;

procedure TheBTreeMap.Swap(var Dest: TValue; const Value: TValue; out Prev: TValue; const CanOverwrite: Boolean);
begin
  Prev := Dest;
  if CanOverwrite then
    Dest := Value;
end;

procedure TheBTreeMap.Underflow(const Parent, P: PPage; const ParentIndex: Integer);
var Left, Right: PPage;
begin
  CheckSiblings(Parent, ParentIndex, Left, Right);
  if (Left <> nil) and (Left^.Count + P^.Count >= 2 * KData) then
    MoveRight(Left, P)
  else if (Right <> nil) and (P^.Count + Right^.Count >= 2 * KData) then
    MoveLeft(P, Right)
  else if Left <> nil then
    Concat(Parent, Left, P, ParentIndex - 1)
  else
    Concat(Parent, P, Right, ParentIndex);
end;

procedure TheBTreeMap.Underflow(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
var Left, Right: PPage;
begin
  CheckSiblings(Parent, ParentIndex, Left, Right);

  if (Left <> nil) and (Left^.Count > KIndex) then begin
    Move(PIndex(P)^.Index[0], PIndex(P)^.Index[1], (2 * P^.Count + 1) * SizeOf(Pointer));
    PIndex(P)^.Index[0].Child := PIndex(Left)^.Index[Left^.Count].Child;
    PIndex(P)^.Index[0].DataPage := PIndex(Parent)^.Index[ParentIndex - 1].DataPage;
    P^.Count += 1;
    Index += 1;
    Left^.Count -= 1;
    PIndex(Parent)^.Index[ParentIndex - 1].DataPage := PIndex(Left)^.Index[Left^.Count].DataPage;
    Exit;
  end;

  if (Right <> nil) and (Right^.Count > KIndex) then begin
    PIndex(P)^.Index[P^.Count].DataPage := PIndex(Parent)^.Index[ParentIndex].DataPage;
    P^.Count += 1;
    PIndex(P)^.Index[P^.Count].Child := PIndex(Right)^.Index[0].Child;
    PIndex(Parent)^.Index[ParentIndex].DataPage := PIndex(Right)^.Index[0].DataPage;
    Move(PIndex(Right)^.Index[1], PIndex(Right)^.Index[0], (2 * Right^.Count + 1) * SizeOf(Pointer));
    Right^.Count -= 1;
    Exit;
  end;

  if Left <> nil then begin
    Index += Left^.Count + 1;
    ConcatIndex(Parent, Left, P, ParentIndex - 1);
    P := Left;
    Exit;
  end;

  ConcatIndex(Parent, P, Right, ParentIndex);
end;

function TheBTreeMap.MissingKeyValue(const Key: TKey): TValue;
begin
  Assert(@Key = @Key); // hint off
  Initialize(Result); // hint off
  raise EMapKeyNotFound.Create(ClassName);
end;

{ TheCmpBTreeSet }

procedure TheCmpBTreeSet.CheckSiblings(const Parent: PPage; const ParentIndex: Integer; out Left, Right: PPage);
begin
  Left := nil;
  Right := nil;
  if ParentIndex >= 0 then begin
    if ParentIndex > 0 then
      Left := PIndex(Parent)^.Index[ParentIndex - 1].Child;
    if ParentIndex < Parent^.Count then
      Right := PIndex(Parent)^.Index[ParentIndex + 1].Child;
  end;
end;

procedure TheCmpBTreeSet.Clear;
begin
  if Root <> nil then begin
    Clear(Root);
    FCount := 0;
    FFirst := nil;
    FLast := nil;
    FRoot  := nil;
  end;
end;

procedure TheCmpBTreeSet.Clear(const P: PPage);
var I: Integer;
begin
  if P^.IsIndex then
    for I := 0 to P^.Count do // Count=n Ch0 Med0 ... Chn-1 Medn-1 Chn
      Clear(PIndex(P)^.Index[I].Child)
  else
    for I := 0 to P^.Count - 1 do
      Finalize(PData(P)^.Data[I]);
  FreeMem(P);
end;

procedure TheCmpBTreeSet.Concat(const Parent, P, Right: PPage; const ParentIndex: Integer);
begin
  MoveLeft(P, Right, Right^.Count);
  if PData(Right)^.Next <> nil then
    PData(Right)^.Next^.Prev := PData(P)
  else
    FLast := P;
  PData(P)^.Next := PData(Right)^.Next;
  FreeMem(Right);
  if Parent^.Count > 1 then begin
    ExtractIndex(Parent, ParentIndex);
    PIndex(Parent)^.Index[ParentIndex].Child := P;
  end else begin
    FreeMem(Root);
    FRoot := P;
  end;
end;

procedure TheCmpBTreeSet.ConcatIndex(const Parent, P, Right: PPage; const ParentIndex: Integer);
begin
  PIndex(P)^.Index[P^.Count].DataPage := PIndex(Parent)^.Index[ParentIndex].DataPage;
  Move(PIndex(Right)^.Index[0], PIndex(P)^.Index[P^.Count + 1], (2 * Right^.Count + 1) * SizeOf(Pointer));
  P^.Count += Right^.Count + 1;
  FreeMem(Right);
  if Parent^.Count > 1 then begin
    Parent^.Count -= 1;
    if ParentIndex < Parent^.Count then
      Move(
        PIndex(Parent)^.Index[ParentIndex + 1].DataPage,
        PIndex(Parent)^.Index[ParentIndex].DataPage,
        2 * (Parent^.Count - ParentIndex) * SizeOf(Pointer)
      );
  end else begin
    FreeMem(Root);
    FRoot := P;
  end;
end;

constructor TheCmpBTreeSet.Create(const AKIndex: Integer; const AKData: Integer);
begin
  inherited Create;
  FKIndex := Max(AKIndex, 2);
  FKData := Max(AKData, 1);
end;

destructor TheCmpBTreeSet.Destroy;
begin
  Clear;
  inherited Destroy;
end;

function TheCmpBTreeSet.Compare(const A, B: TItem): Integer;
begin
  Result := 0; // hint off
  Assert(@A = @A); // hint off
  Assert(@B = @B); // hint off
  raise EAbstractError.Create(Format('%s.Compare', [ClassName]));
end;

function TheCmpBTreeSet.Exclude(const Item: TItem): Boolean;
var
  Parent, P, DataPage: PPage;
  Index, ParentIndex: Integer;
begin
  Result := False;
  ParentIndex := -1;
  Parent := nil;
  P := Root;
  if P <> nil then
    repeat
      Result := Find(P, Item, Index);
      if Result then // Key found
        if P^.IsIndex then begin
          DataPage := PPage(PIndex(P)^.Index[Index].DataPage);
          if DataPage^.Count > KData then
            ExtractData(DataPage, 0)
          else begin
            if (P^.Count < KIndex) and (P <> Root) then
              Underflow(Parent, P, ParentIndex, Index);
            ParentIndex := Index + 1;
            Parent := P;
            P := PIndex(P)^.Index[ParentIndex].Child;
            Result := False;
          end;
        end else begin
          ExtractData(P, Index);
          if P^.Count < KData then
            if P <> Root then
              Underflow(Parent, P, ParentIndex)
            else if Count = 0 then
              Clear;
        end
      else if P^.IsIndex then begin
        if (P^.Count < KIndex) and (P <> Root) then
          Underflow(Parent, P, ParentIndex, Index);
        ParentIndex := Index;
        Parent := P;
        P := PIndex(P)^.Index[Index].Child;
      end else
        break; // give up
    until Result
end;

function TheCmpBTreeSet.GetEnumerator: TEnumerator;
var Iterator: TIterator;
begin
  Iterator.Page := PData(FFirst);
  Iterator.Index := -1;
  Iterator.UseSentinel := False;
  Assert(Iterator.Page = Iterator.Page); // hint off
  Result.Init(Iterator, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@GetCurrent));
end;

function TheCmpBTreeSet.Include(const Item: TItem): Boolean;
var
  P, Parent: PPage;
  Index, ParentIndex: Integer;
begin
  Result := False;
  ParentIndex := -1;
  Parent := nil;
  P := Root;
  if P <> nil then
    repeat
      if Find(P, Item, Index) then // Key found
        Exit(True);

      if P^.IsIndex then begin
        if P^.Count > 2 * KIndex then
          SplitIndex(Parent, P, ParentIndex, Index);
        ParentIndex := Index;
        Parent := P;
        P := PIndex(P)^.Index[Index].Child
      end else begin
        if P^.Count < 2 * KData then // page is not full
          InsertItem(P, Index, Item)
        else // page is full
          Overflow(Parent, P, ParentIndex, Index, Item);
        Exit(False);
      end;
    until False
  else begin // tree is empty
    FRoot := InsertItem(Page(False), 0, Item);
    FFirst := Root;
    FLast := Root;
  end;
end;

function TheCmpBTreeSet.Reversed: TEnumeratorProvider;
var Iterator: TIterator;
begin
  Iterator.Page := PData(FLast);
  Iterator.UseSentinel := False;
  if FLast <> nil then
    Iterator.Index := FLast^.Count;
  Assert(Iterator.Page = Iterator.Page); // hint off
  Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrent);
end;

function TheCmpBTreeSet.ExtractData(const P: PPage; const Index: Integer): TItem;
begin
  Result := PData(P)^.Data[Index];
  Finalize(PData(P)^.Data[Index]);
  P^.Count -= 1;
  if Index < P^.Count then
    Move(PData(P)^.Data[Index + 1], PData(P)^.Data[Index], (P^.Count - Index) * SizeOf(PData(P)^.Data[0]));
  FCount -=1;
end;

procedure TheCmpBTreeSet.ExtractIndex(const P: PPage; const Index: Integer);
begin
  P^.Count -= 1;
  if Index < P^.Count then
    Move(PIndex(P)^.Index[Index + 1], PIndex(P)^.Index[Index], ((P^.Count - Index) * 2 + 1) * SizeOf(Pointer));
end;

function TheCmpBTreeSet.Find(const P: PPage; const Item: TItem; out Index: Integer): Boolean;
type PItem = ^TItem;
var
  L, H, Cmp: Integer;
  MidItem: PItem;
  Mid: Integer absolute Index;
begin
  L := 0;
  H := P^.Count - 1;
  while L <= H do begin
    Mid := (L + H) shr 1;
    if P^.IsIndex then
      MidItem := @PIndex(P)^.Index[Mid].DataPage^.Data[0]
    else
      MidItem := @PData(P)^.Data[Mid];
    Cmp := Compare(Item, MidItem^);
    if Cmp > 0 then
      L := Mid + 1
    else if Cmp = 0 then
      Exit(True)
    else
      H := Mid - 1;
  end;
  Index  := L;
  Result := False;
end;

function TheCmpBTreeSet.GetFirst: TItem;
begin
  Assert(Count <> 0);
  Result := PData(FFirst)^.Data[0];
end;

function TheCmpBTreeSet.GetLast: TItem;
begin
  Assert(Count <> 0);
  Result := PData(FLast)^.Data[FLast^.Count - 1];
end;

function TheCmpBTreeSet.GetCurrent(var Iterator: TIterator): TItem;
begin
  Result := Iterator.Page^.Data[Iterator.Index];
end;

function TheCmpBTreeSet.GetMembership(const Item: TItem): Boolean;
var
  P: PData;
  Index: Integer;
begin
  Result := Seek(Item, P, Index);
end;

function TheCmpBTreeSet.GetRange(const RangeFrom, RangeTo: TItem): TEnumeratorProvider;
var Iterator: TIterator;
begin
  Iterator.UseSentinel := True;
  Iterator.Sentinel := RangeTo;

  if Compare(RangeFrom, RangeTo) <= 0 then begin
    Seek(RangeFrom, Iterator.Page, Iterator.Index);
    Dec(Iterator.Index);
    Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrent);
    Exit;
  end;

  // RangeFrom > RangeTo
  if Seek(RangeFrom, Iterator.Page, Iterator.Index) and (Iterator.Index < PPage(Iterator.Page)^.Count) then
    Inc(Iterator.Index);
  Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrent);
end;

function TheCmpBTreeSet.Insert(const P: PPage; const Index: Integer): PPage;
begin
  if Index < P^.Count then
    if P^.IsIndex then
      Move(PIndex(P)^.Index[Index].DataPage, PIndex(P)^.Index[Index + 1].DataPage, (P^.Count - Index) * 2 * SizeOf(Pointer))
    else
      Move(PData(P)^.Data[Index], PData(P)^.Data[Index + 1], (P^.Count - Index) * SizeOf(PData(P)^.Data[0]));
  Inc(P^.Count);
  Result := P;
end;

function TheCmpBTreeSet.Insert(const P: PPage; const Index: Integer; const DataPage, Child: PPage): PPage;
begin
  Result := Insert(P, Index);
  PIndex(Result)^.Index[Index].DataPage := PData(DataPage);
  PIndex(Result)^.Index[Index + 1].Child := Child;
end;

function TheCmpBTreeSet.InsertItem(const P: PPage; const Index: Integer; const Item: TItem): PPage;
begin
  Result := Insert(P, Index);
  Initialize(PData(P)^.Data[Index]);
  PData(P)^.Data[Index] := Item;
  Inc(FCount);
end;

function TheCmpBTreeSet.MoveNext(var Iterator: TIterator): Boolean;
begin
  while Iterator.Page <> nil do begin
    Inc(Iterator.Index);
    if Iterator.Index < PPage(Iterator.Page)^.Count then
      Exit(not Iterator.UseSentinel or (Compare(Iterator.Page^.Data[Iterator.Index], Iterator.Sentinel) <= 0));
    Iterator.Page := Iterator.Page^.Next;
    Iterator.Index := -1;
  end;
  Result := False;
end;

function TheCmpBTreeSet.MovePrev(var Iterator: TIterator): Boolean;
begin
  while Iterator.Page <> nil do begin
    Dec(Iterator.Index);
    if Iterator.Index >= 0 then
      Exit(not Iterator.UseSentinel or (Compare(Iterator.Page^.Data[Iterator.Index], Iterator.Sentinel) >= 0));
    Iterator.Page := Iterator.Page^.Prev;
    if Iterator.Page <> nil then
      Iterator.Index := PPage(Iterator.Page)^.Count;
  end;
  Result := False;
end;

procedure TheCmpBTreeSet.MoveLeft(const Left, P: PPage; const N: Integer);
begin
  Move(PData(P)^.Data[0], PData(Left)^.Data[Left^.Count], N * SizeOf(PData(P)^.Data[0]));
  Move(PData(P)^.Data[N], PData(P)^.Data[0], (P^.Count - N) * SizeOf(PData(P)^.Data[0]));
  Left^.Count += N;
  P^.Count -= N;
end;

procedure TheCmpBTreeSet.MoveRight(const P, Right: PPage; const N: Integer);
begin
  Move(PData(Right)^.Data[0], PData(Right)^.Data[N], Right^.Count * SizeOf(PData(P)^.Data[0]));
  Move(PData(P)^.Data[P^.Count - N], PData(Right)^.Data[0], N * SizeOf(PData(P)^.Data[0]));
  Right^.Count += N;
  P^.Count -= N;
end;

procedure TheCmpBTreeSet.Overflow(const Parent, P: PPage; const ParentIndex, Index: Integer; const Item: TItem);
var Left, Right: PPage;
begin
  CheckSiblings(Parent, ParentIndex, Left, Right);

  if (Left <> nil) and (Left^.Count < 2 * KData) then begin
    MoveLeft(Left, P);
    InsertItem(P, Index - 1, Item);
    Exit;
  end;

  if (Right <> nil) and (Right^.Count < 2 * KData) then begin
    if Index < 2 * KData then begin
      MoveRight(P, Right);
      InsertItem(P, Index, Item)
    end else
      InsertItem(Right, 0, Item);
    Exit;
  end;

  SplitData(Parent, P, ParentIndex, Index, Item);
end;

procedure TheCmpBTreeSet.SetMembership(const Item: TItem; const AValue: Boolean);
begin
  if AValue then
    Include(Item)
  else
    Exclude(Item);
end;

function TheCmpBTreeSet.Page(const IsIndex: Boolean; const LeftmostChild: PPage): PPage;
begin
  if IsIndex then begin
    GetMem(Result, SizeOf(TPage.Count) + SizeOf(TPage.IsIndex) + (4 * KIndex + 3) * SizeOf(Pointer));
    PIndex(Result)^.Index[0].Child := LeftmostChild;
  end else begin
    GetMem(Result, SizeOf(TPage.Count) + SizeOf(TPage.IsIndex) + 2 * SizeOf(Pointer) +  2 * KData * SizeOf(TDataPage.Data[0]));
    PData(Result)^.Prev := nil;
    PData(Result)^.Next := nil;
  end;
  Result^.IsIndex := IsIndex;
  Result^.Count := 0;
end;

function TheCmpBTreeSet.Seek(const Item: TItem; out P: PData; out Index: Integer): Boolean;
begin
  Result := False;
  P := PData(Root);
  if P <> nil then begin // tree is non empty
    repeat
      Result := Find(PPage(P), Item, Index);
      if Result then begin // Key found
        if PPage(P)^.IsIndex then begin
          P := PIndex(P)^.Index[Index].DataPage;
          Index := 0;
        end;
      end else if PPage(P)^.IsIndex then
        P := PData(PIndex(P)^.Index[Index].Child)
      else
        break;
    until Result;
  end;
end;

procedure TheCmpBTreeSet.SplitData(const Parent, P: PPage; const ParentIndex, Index: Integer; const Item: TItem);
var Right: PPage;
begin
  Right := Page(False);
  if PData(P)^.Next <> nil then begin // P was not last
    PData(Right)^.Next := PData(P)^.Next;
    PData(Right)^.Next^.Prev := PData(Right);
  end else  // P was last
    FLast := Right;
  PData(P)^.Next := PData(Right);
  PData(Right)^.Prev := PData(P);
  Move(PData(P)^.Data[KData], PData(Right)^.Data[0], KData * SizeOf(PData(P)^.Data[0]));
  P^.Count := KData;
  Right^.Count := KData;
  if ParentIndex >= 0 then
    Insert(Parent, ParentIndex, Right, Right)
  else
    FRoot := Insert(Page(True, P), 0, Right, Right);
  if Index > KData then
    InsertItem(Right, Index - KData, Item)
  else
    InsertItem(P, Index, Item);
end;

procedure TheCmpBTreeSet.SplitIndex(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
var Right: PPage;
begin
  Right := Page(True);
  Move(PIndex(P)^.Index[KIndex + 1], PIndex(Right)^.Index[0], (2 * KIndex + 1) * SizeOf(Pointer));
  P^.Count := KIndex;
  Right^.Count := KIndex;
  if ParentIndex >= 0 then
    Insert(Parent, ParentIndex, PPage(PIndex(P)^.Index[KIndex].DataPage), Right)
  else
    FRoot := Insert(Page(True, P), 0, PPage(PIndex(P)^.Index[KIndex].DataPage), Right);
  if Index > KIndex then begin
    P := Right;
    Index -= KIndex + 1;
  end;
end;

procedure TheCmpBTreeSet.Underflow(const Parent, P: PPage; const ParentIndex: Integer);
var Left, Right: PPage;
begin
  CheckSiblings(Parent, ParentIndex, Left, Right);
  if (Left <> nil) and (Left^.Count + P^.Count >= 2 * KData) then
    MoveRight(Left, P)
  else if (Right <> nil) and (P^.Count + Right^.Count >= 2 * KData) then
    MoveLeft(P, Right)
  else if Left <> nil then
    Concat(Parent, Left, P, ParentIndex - 1)
  else
    Concat(Parent, P, Right, ParentIndex);
end;

procedure TheCmpBTreeSet.Underflow(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
var Left, Right: PPage;
begin
  CheckSiblings(Parent, ParentIndex, Left, Right);

  if (Left <> nil) and (Left^.Count > KIndex) then begin
    Move(PIndex(P)^.Index[0], PIndex(P)^.Index[1], (2 * P^.Count + 1) * SizeOf(Pointer));
    PIndex(P)^.Index[0].Child := PIndex(Left)^.Index[Left^.Count].Child;
    PIndex(P)^.Index[0].DataPage := PIndex(Parent)^.Index[ParentIndex - 1].DataPage;
    P^.Count += 1;
    Index += 1;
    Left^.Count -= 1;
    PIndex(Parent)^.Index[ParentIndex - 1].DataPage := PIndex(Left)^.Index[Left^.Count].DataPage;
    Exit;
  end;

  if (Right <> nil) and (Right^.Count > KIndex) then begin
    PIndex(P)^.Index[P^.Count].DataPage := PIndex(Parent)^.Index[ParentIndex].DataPage;
    P^.Count += 1;
    PIndex(P)^.Index[P^.Count].Child := PIndex(Right)^.Index[0].Child;
    PIndex(Parent)^.Index[ParentIndex].DataPage := PIndex(Right)^.Index[0].DataPage;
    Move(PIndex(Right)^.Index[1], PIndex(Right)^.Index[0], (2 * Right^.Count + 1) * SizeOf(Pointer));
    Right^.Count -= 1;
    Exit;
  end;

  if Left <> nil then begin
    Index += Left^.Count + 1;
    ConcatIndex(Parent, Left, P, ParentIndex - 1);
    P := Left;
    Exit;
  end;

  ConcatIndex(Parent, P, Right, ParentIndex);
end;

{ TheObjectBTreeSet }

procedure TheObjectBTreeSet.CheckSiblings(const Parent: PPage; const ParentIndex: Integer; out Left, Right: PPage);
begin
  Left := nil;
  Right := nil;
  if ParentIndex >= 0 then begin
    if ParentIndex > 0 then
      Left := PIndex(Parent)^.Index[ParentIndex - 1].Child;
    if ParentIndex < Parent^.Count then
      Right := PIndex(Parent)^.Index[ParentIndex + 1].Child;
  end;
end;

procedure TheObjectBTreeSet.Clear;
begin
  if Root <> nil then begin
    Clear(Root);
    FCount := 0;
    FFirst := nil;
    FLast := nil;
    FRoot  := nil;
  end;
end;

procedure TheObjectBTreeSet.Clear(const P: PPage);
var I: Integer;
begin
  if P^.IsIndex then
    for I := 0 to P^.Count do // Count=n Ch0 Med0 ... Chn-1 Medn-1 Chn
      Clear(PIndex(P)^.Index[I].Child)
  else if OwnObjects then
    for I := 0 to P^.Count - 1 do
      PData(P)^.Data[I].Free;
  FreeMem(P);
end;

procedure TheObjectBTreeSet.Concat(const Parent, P, Right: PPage; const ParentIndex: Integer);
begin
  MoveLeft(P, Right, Right^.Count);
  if PData(Right)^.Next <> nil then
    PData(Right)^.Next^.Prev := PData(P)
  else
    FLast := P;
  PData(P)^.Next := PData(Right)^.Next;
  FreeMem(Right);
  if Parent^.Count > 1 then begin
    ExtractIndex(Parent, ParentIndex);
    PIndex(Parent)^.Index[ParentIndex].Child := P;
  end else begin
    FreeMem(Root);
    FRoot := P;
  end;
end;

procedure TheObjectBTreeSet.ConcatIndex(const Parent, P, Right: PPage; const ParentIndex: Integer);
begin
  PIndex(P)^.Index[P^.Count].DataPage := PIndex(Parent)^.Index[ParentIndex].DataPage;
  Move(PIndex(Right)^.Index[0], PIndex(P)^.Index[P^.Count + 1], (2 * Right^.Count + 1) * SizeOf(Pointer));
  P^.Count += Right^.Count + 1;
  FreeMem(Right);
  if Parent^.Count > 1 then begin
    Parent^.Count -= 1;
    if ParentIndex < Parent^.Count then
      Move(
        PIndex(Parent)^.Index[ParentIndex + 1].DataPage,
        PIndex(Parent)^.Index[ParentIndex].DataPage,
        2 * (Parent^.Count - ParentIndex) * SizeOf(Pointer)
      );
  end else begin
    FreeMem(Root);
    FRoot := P;
  end;
end;

constructor TheObjectBTreeSet.Create(const AOwnObjects: Boolean; const AKIndex: Integer; const AKData: Integer);
begin
  inherited Create;
  FOwnObjects := AOwnObjects;
  FKIndex := Max(AKIndex, 2);
  FKData := Max(AKData, 1);
end;

destructor TheObjectBTreeSet.Destroy;
begin
  Clear;
  inherited Destroy;
end;

function TheObjectBTreeSet.Compare(const A, B: TItem): Integer;
begin
  Result := 0; // hint off
  Assert(@A = @A); // hint off
  Assert(@B = @B); // hint off
  raise EAbstractError.Create(Format('%s.Compare', [ClassName]));
end;

function TheObjectBTreeSet.Exclude(const Item: TItem): Boolean;
var
  Parent, P, DataPage: PPage;
  Index, ParentIndex: Integer;
begin
  Result := False;
  ParentIndex := -1;
  Parent := nil;
  P := Root;
  if P <> nil then
    repeat
      Result := Find(P, Item, Index);
      if Result then // Key found
        if P^.IsIndex then begin
          DataPage := PPage(PIndex(P)^.Index[Index].DataPage);
          if DataPage^.Count > KData then
            ExtractData(DataPage, 0)
          else begin
            if (P^.Count < KIndex) and (P <> Root) then
              Underflow(Parent, P, ParentIndex, Index);
            ParentIndex := Index + 1;
            Parent := P;
            P := PIndex(P)^.Index[ParentIndex].Child;
            Result := False;
          end;
        end else begin
          ExtractData(P, Index);
          if P^.Count < KData then
            if P <> Root then
              Underflow(Parent, P, ParentIndex)
            else if Count = 0 then
              Clear;
        end
      else if P^.IsIndex then begin
        if (P^.Count < KIndex) and (P <> Root) then
          Underflow(Parent, P, ParentIndex, Index);
        ParentIndex := Index;
        Parent := P;
        P := PIndex(P)^.Index[Index].Child;
      end else
        break; // give up
    until Result
end;

function TheObjectBTreeSet.GetEnumerator: TEnumerator;
var Iterator: TIterator;
begin
  Iterator.Page := PData(FFirst);
  Iterator.Index := -1;
  Iterator.UseSentinel := False;
  Assert(Iterator.Page = Iterator.Page); // hint off
  Result.Init(Iterator, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@GetCurrent));
end;

function TheObjectBTreeSet.Include(const Item: TItem): Boolean;
var
  P, Parent: PPage;
  Index, ParentIndex: Integer;
begin
  Result := False;
  ParentIndex := -1;
  Parent := nil;
  P := Root;
  if P <> nil then
    repeat
      if Find(P, Item, Index) then // Key found
        Exit(True);

      if P^.IsIndex then begin
        if P^.Count > 2 * KIndex then
          SplitIndex(Parent, P, ParentIndex, Index);
        ParentIndex := Index;
        Parent := P;
        P := PIndex(P)^.Index[Index].Child
      end else begin
        if P^.Count < 2 * KData then // page is not full
          InsertItem(P, Index, Item)
        else // page is full
          Overflow(Parent, P, ParentIndex, Index, Item);
        Exit(False);
      end;
    until False
  else begin // tree is empty
    FRoot := InsertItem(Page(False), 0, Item);
    FFirst := Root;
    FLast := Root;
  end;
end;

function TheObjectBTreeSet.Reversed: TEnumeratorProvider;
var Iterator: TIterator;
begin
  Iterator.Page := PData(FLast);
  Iterator.UseSentinel := False;
  if FLast <> nil then
    Iterator.Index := FLast^.Count;
  Assert(Iterator.Page = Iterator.Page); // hint off
  Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrent);
end;

function TheObjectBTreeSet.ExtractData(const P: PPage; const Index: Integer): TItem;
begin
  Result := PData(P)^.Data[Index];
  P^.Count -= 1;
  if Index < P^.Count then
    Move(PData(P)^.Data[Index + 1], PData(P)^.Data[Index], (P^.Count - Index) * SizeOf(PData(P)^.Data[0]));
  FCount -=1;
end;

procedure TheObjectBTreeSet.ExtractIndex(const P: PPage; const Index: Integer);
begin
  P^.Count -= 1;
  if Index < P^.Count then
    Move(PIndex(P)^.Index[Index + 1], PIndex(P)^.Index[Index], ((P^.Count - Index) * 2 + 1) * SizeOf(Pointer));
end;

function TheObjectBTreeSet.Find(const P: PPage; const Item: TItem; out Index: Integer): Boolean;
type PItem = ^TItem;
var
  L, H, Cmp: Integer;
  MidItem: PItem;
  Mid: Integer absolute Index;
begin
  L := 0;
  H := P^.Count - 1;
  while L <= H do begin
    Mid := (L + H) shr 1;
    if P^.IsIndex then
      MidItem := @PIndex(P)^.Index[Mid].DataPage^.Data[0]
    else
      MidItem := @PData(P)^.Data[Mid];
    Cmp := Compare(Item, MidItem^);
    if Cmp > 0 then
      L := Mid + 1
    else if Cmp = 0 then
      Exit(True)
    else
      H := Mid - 1;
  end;
  Index  := L;
  Result := False;
end;

function TheObjectBTreeSet.GetFirst: TItem;
begin
  Assert(Count <> 0);
  Result := PData(FFirst)^.Data[0];
end;

function TheObjectBTreeSet.GetLast: TItem;
begin
  Assert(Count <> 0);
  Result := PData(FLast)^.Data[FLast^.Count - 1];
end;

function TheObjectBTreeSet.GetCurrent(var Iterator: TIterator): TItem;
begin
  Result := Iterator.Page^.Data[Iterator.Index];
end;

function TheObjectBTreeSet.GetMembership(const Item: TItem): Boolean;
var
  P: PData;
  Index: Integer;
begin
  Result := Seek(Item, P, Index);
end;

function TheObjectBTreeSet.GetRange(const RangeFrom, RangeTo: TItem): TEnumeratorProvider;
var Iterator: TIterator;
begin
  Iterator.UseSentinel := True;
  Iterator.Sentinel := RangeTo;

  if Compare(RangeFrom, RangeTo) <= 0 then begin
    Seek(RangeFrom, Iterator.Page, Iterator.Index);
    Dec(Iterator.Index);
    Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrent);
    Exit;
  end;

  // RangeFrom > RangeTo
  if Seek(RangeFrom, Iterator.Page, Iterator.Index) and (Iterator.Index < PPage(Iterator.Page)^.Count) then
    Inc(Iterator.Index);
  Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrent);
end;

function TheObjectBTreeSet.Insert(const P: PPage; const Index: Integer): PPage;
begin
  if Index < P^.Count then
    if P^.IsIndex then
      Move(PIndex(P)^.Index[Index].DataPage, PIndex(P)^.Index[Index + 1].DataPage, (P^.Count - Index) * 2 * SizeOf(Pointer))
    else
      Move(PData(P)^.Data[Index], PData(P)^.Data[Index + 1], (P^.Count - Index) * SizeOf(PData(P)^.Data[0]));
  Inc(P^.Count);
  Result := P;
end;

function TheObjectBTreeSet.Insert(const P: PPage; const Index: Integer; const DataPage, Child: PPage): PPage;
begin
  Result := Insert(P, Index);
  PIndex(Result)^.Index[Index].DataPage := PData(DataPage);
  PIndex(Result)^.Index[Index + 1].Child := Child;
end;

function TheObjectBTreeSet.InsertItem(const P: PPage; const Index: Integer; const Item: TItem): PPage;
begin
  Result := Insert(P, Index);
  PData(P)^.Data[Index] := Item;
  Inc(FCount);
end;

function TheObjectBTreeSet.MoveNext(var Iterator: TIterator): Boolean;
begin
  while Iterator.Page <> nil do begin
    Inc(Iterator.Index);
    if Iterator.Index < PPage(Iterator.Page)^.Count then
      Exit(not Iterator.UseSentinel or (Compare(Iterator.Page^.Data[Iterator.Index], Iterator.Sentinel) <= 0));
    Iterator.Page := Iterator.Page^.Next;
    Iterator.Index := -1;
  end;
  Result := False;
end;

function TheObjectBTreeSet.MovePrev(var Iterator: TIterator): Boolean;
begin
  while Iterator.Page <> nil do begin
    Dec(Iterator.Index);
    if Iterator.Index >= 0 then
      Exit(not Iterator.UseSentinel or (Compare(Iterator.Page^.Data[Iterator.Index], Iterator.Sentinel) >= 0));
    Iterator.Page := Iterator.Page^.Prev;
    if Iterator.Page <> nil then
      Iterator.Index := PPage(Iterator.Page)^.Count;
  end;
  Result := False;
end;

procedure TheObjectBTreeSet.MoveLeft(const Left, P: PPage; const N: Integer);
begin
  Move(PData(P)^.Data[0], PData(Left)^.Data[Left^.Count], N * SizeOf(PData(P)^.Data[0]));
  Move(PData(P)^.Data[N], PData(P)^.Data[0], (P^.Count - N) * SizeOf(PData(P)^.Data[0]));
  Left^.Count += N;
  P^.Count -= N;
end;

procedure TheObjectBTreeSet.MoveRight(const P, Right: PPage; const N: Integer);
begin
  Move(PData(Right)^.Data[0], PData(Right)^.Data[N], Right^.Count * SizeOf(PData(P)^.Data[0]));
  Move(PData(P)^.Data[P^.Count - N], PData(Right)^.Data[0], N * SizeOf(PData(P)^.Data[0]));
  Right^.Count += N;
  P^.Count -= N;
end;

procedure TheObjectBTreeSet.Overflow(const Parent, P: PPage; const ParentIndex, Index: Integer; const Item: TItem);
var Left, Right: PPage;
begin
  CheckSiblings(Parent, ParentIndex, Left, Right);

  if (Left <> nil) and (Left^.Count < 2 * KData) then begin
    MoveLeft(Left, P);
    InsertItem(P, Index - 1, Item);
    Exit;
  end;

  if (Right <> nil) and (Right^.Count < 2 * KData) then begin
    if Index < 2 * KData then begin
      MoveRight(P, Right);
      InsertItem(P, Index, Item)
    end else
      InsertItem(Right, 0, Item);
    Exit;
  end;

  SplitData(Parent, P, ParentIndex, Index, Item);
end;

procedure TheObjectBTreeSet.SetMembership(const Item: TItem; const AValue: Boolean);
begin
  if AValue then
    Include(Item)
  else
    Exclude(Item);
end;

function TheObjectBTreeSet.Page(const IsIndex: Boolean; const LeftmostChild: PPage): PPage;
begin
  if IsIndex then begin
    GetMem(Result, SizeOf(TPage.Count) + SizeOf(TPage.IsIndex) + (4 * KIndex + 3) * SizeOf(Pointer));
    PIndex(Result)^.Index[0].Child := LeftmostChild;
  end else begin
    GetMem(Result, SizeOf(TPage.Count) + SizeOf(TPage.IsIndex) + 2 * SizeOf(Pointer) +  2 * KData * SizeOf(TDataPage.Data[0]));
    PData(Result)^.Prev := nil;
    PData(Result)^.Next := nil;
  end;
  Result^.IsIndex := IsIndex;
  Result^.Count := 0;
end;

function TheObjectBTreeSet.Seek(const Item: TItem; out P: PData; out Index: Integer): Boolean;
begin
  Result := False;
  P := PData(Root);
  if P <> nil then begin // tree is non empty
    repeat
      Result := Find(PPage(P), Item, Index);
      if Result then begin // Key found
        if PPage(P)^.IsIndex then begin
          P := PIndex(P)^.Index[Index].DataPage;
          Index := 0;
        end;
      end else if PPage(P)^.IsIndex then
        P := PData(PIndex(P)^.Index[Index].Child)
      else
        break;
    until Result;
  end;
end;

procedure TheObjectBTreeSet.SplitData(const Parent, P: PPage; const ParentIndex, Index: Integer; const Item: TItem);
var Right: PPage;
begin
  Right := Page(False);
  if PData(P)^.Next <> nil then begin // P was not last
    PData(Right)^.Next := PData(P)^.Next;
    PData(Right)^.Next^.Prev := PData(Right);
  end else  // P was last
    FLast := Right;
  PData(P)^.Next := PData(Right);
  PData(Right)^.Prev := PData(P);
  Move(PData(P)^.Data[KData], PData(Right)^.Data[0], KData * SizeOf(PData(P)^.Data[0]));
  P^.Count := KData;
  Right^.Count := KData;
  if ParentIndex >= 0 then
    Insert(Parent, ParentIndex, Right, Right)
  else
    FRoot := Insert(Page(True, P), 0, Right, Right);
  if Index > KData then
    InsertItem(Right, Index - KData, Item)
  else
    InsertItem(P, Index, Item);
end;

procedure TheObjectBTreeSet.SplitIndex(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
var Right: PPage;
begin
  Right := Page(True);
  Move(PIndex(P)^.Index[KIndex + 1], PIndex(Right)^.Index[0], (2 * KIndex + 1) * SizeOf(Pointer));
  P^.Count := KIndex;
  Right^.Count := KIndex;
  if ParentIndex >= 0 then
    Insert(Parent, ParentIndex, PPage(PIndex(P)^.Index[KIndex].DataPage), Right)
  else
    FRoot := Insert(Page(True, P), 0, PPage(PIndex(P)^.Index[KIndex].DataPage), Right);
  if Index > KIndex then begin
    P := Right;
    Index -= KIndex + 1;
  end;
end;

procedure TheObjectBTreeSet.Underflow(const Parent, P: PPage; const ParentIndex: Integer);
var Left, Right: PPage;
begin
  CheckSiblings(Parent, ParentIndex, Left, Right);
  if (Left <> nil) and (Left^.Count + P^.Count >= 2 * KData) then
    MoveRight(Left, P)
  else if (Right <> nil) and (P^.Count + Right^.Count >= 2 * KData) then
    MoveLeft(P, Right)
  else if Left <> nil then
    Concat(Parent, Left, P, ParentIndex - 1)
  else
    Concat(Parent, P, Right, ParentIndex);
end;

procedure TheObjectBTreeSet.Underflow(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
var Left, Right: PPage;
begin
  CheckSiblings(Parent, ParentIndex, Left, Right);

  if (Left <> nil) and (Left^.Count > KIndex) then begin
    Move(PIndex(P)^.Index[0], PIndex(P)^.Index[1], (2 * P^.Count + 1) * SizeOf(Pointer));
    PIndex(P)^.Index[0].Child := PIndex(Left)^.Index[Left^.Count].Child;
    PIndex(P)^.Index[0].DataPage := PIndex(Parent)^.Index[ParentIndex - 1].DataPage;
    P^.Count += 1;
    Index += 1;
    Left^.Count -= 1;
    PIndex(Parent)^.Index[ParentIndex - 1].DataPage := PIndex(Left)^.Index[Left^.Count].DataPage;
    Exit;
  end;

  if (Right <> nil) and (Right^.Count > KIndex) then begin
    PIndex(P)^.Index[P^.Count].DataPage := PIndex(Parent)^.Index[ParentIndex].DataPage;
    P^.Count += 1;
    PIndex(P)^.Index[P^.Count].Child := PIndex(Right)^.Index[0].Child;
    PIndex(Parent)^.Index[ParentIndex].DataPage := PIndex(Right)^.Index[0].DataPage;
    Move(PIndex(Right)^.Index[1], PIndex(Right)^.Index[0], (2 * Right^.Count + 1) * SizeOf(Pointer));
    Right^.Count -= 1;
    Exit;
  end;

  if Left <> nil then begin
    Index += Left^.Count + 1;
    ConcatIndex(Parent, Left, P, ParentIndex - 1);
    P := Left;
    Exit;
  end;

  ConcatIndex(Parent, P, Right, ParentIndex);
end;

{ TheCmpBTreeMap }

procedure TheCmpBTreeMap.CheckSiblings(const Parent: PPage; const ParentIndex: Integer; out Left, Right: PPage);
begin
  Left := nil;
  Right := nil;
  if ParentIndex >= 0 then begin
    if ParentIndex > 0 then
      Left := PIndex(Parent)^.Index[ParentIndex - 1].Child;
    if ParentIndex < Parent^.Count then
      Right := PIndex(Parent)^.Index[ParentIndex + 1].Child;
  end;
end;

procedure TheCmpBTreeMap.Clear;
begin
  if Root <> nil then begin
    Clear(Root);
    FCount := 0;
    FFirst := nil;
    FLast := nil;
    FRoot  := nil;
  end;
end;

procedure TheCmpBTreeMap.Clear(const P: PPage);
var I: Integer;
begin
  if P^.IsIndex then
    for I := 0 to P^.Count do // Count=n Ch0 Med0 ... Chn-1 Medn-1 Chn
      Clear(PIndex(P)^.Index[I].Child)
  else
    for I := 0 to P^.Count - 1 do
      Finalize(PData(P)^.Data[I]);
  FreeMem(P);
end;

procedure TheCmpBTreeMap.Concat(const Parent, P, Right: PPage; const ParentIndex: Integer);
begin
  MoveLeft(P, Right, Right^.Count);
  if PData(Right)^.Next <> nil then
    PData(Right)^.Next^.Prev := PData(P)
  else
    FLast := P;
  PData(P)^.Next := PData(Right)^.Next;
  FreeMem(Right);
  if Parent^.Count > 1 then begin
    ExtractIndex(Parent, ParentIndex);
    PIndex(Parent)^.Index[ParentIndex].Child := P;
  end else begin
    FreeMem(Root);
    FRoot := P;
  end;
end;

procedure TheCmpBTreeMap.ConcatIndex(const Parent, P, Right: PPage; const ParentIndex: Integer);
begin
  PIndex(P)^.Index[P^.Count].DataPage := PIndex(Parent)^.Index[ParentIndex].DataPage;
  Move(PIndex(Right)^.Index[0], PIndex(P)^.Index[P^.Count + 1], (2 * Right^.Count + 1) * SizeOf(Pointer));
  P^.Count += Right^.Count + 1;
  FreeMem(Right);
  if Parent^.Count > 1 then begin
    Parent^.Count -= 1;
    if ParentIndex < Parent^.Count then
      Move(
        PIndex(Parent)^.Index[ParentIndex + 1].DataPage,
        PIndex(Parent)^.Index[ParentIndex].DataPage,
        2 * (Parent^.Count - ParentIndex) * SizeOf(Pointer)
      );
  end else begin
    FreeMem(Root);
    FRoot := P;
  end;
end;

constructor TheCmpBTreeMap.Create(const AKIndex: Integer; const AKData: Integer);
begin
  inherited Create;
  FKIndex := Max(AKIndex, 2);
  FKData := Max(AKData, 1);
end;

function TheCmpBTreeMap.Delete(const Key: TKey): Boolean;
var Dummy: TValue;
begin
  Result := Extract(Key, Dummy);
end;

destructor TheCmpBTreeMap.Destroy;
begin
  Clear;
  inherited Destroy;
end;

function TheCmpBTreeMap.Compare(const A, B: TKey): Integer;
begin
  Result := 0; // hint off
  Assert(@A = @A); // hint off
  Assert(@B = @B); // hint off
  raise EAbstractError.Create(Format('%s.Compare', [ClassName]));
end;

function TheCmpBTreeMap.ExtractData(const P: PPage; const Index: Integer): TValue;
begin
  Result := PData(P)^.Data[Index].Value;
  Finalize(PData(P)^.Data[Index]);
  P^.Count -= 1;
  if Index < P^.Count then
    Move(PData(P)^.Data[Index + 1], PData(P)^.Data[Index], (P^.Count - Index) * SizeOf(PData(P)^.Data[0]));
  FCount -=1;
end;

procedure TheCmpBTreeMap.ExtractIndex(const P: PPage; const Index: Integer);
begin
  P^.Count -= 1;
  if Index < P^.Count then
    Move(PIndex(P)^.Index[Index + 1], PIndex(P)^.Index[Index], ((P^.Count - Index) * 2 + 1) * SizeOf(Pointer));
end;

function TheCmpBTreeMap.Extract(const Key: TKey; out Value: TValue): Boolean;
var
  Parent, P, DataPage: PPage;
  Index, ParentIndex: Integer;
begin
  Result := False;
  ParentIndex := -1;
  Parent := nil;
  P := Root;
  if P <> nil then
    repeat
      Result := Find(P, Key, Index);
      if Result then // Key found
        if P^.IsIndex then begin
          DataPage := PPage(PIndex(P)^.Index[Index].DataPage);
          if DataPage^.Count > KData then
            Value := ExtractData(DataPage, 0)
          else begin
            if (P^.Count < KIndex) and (P <> Root) then
              Underflow(Parent, P, ParentIndex, Index);
            ParentIndex := Index + 1;
            Parent := P;
            P := PIndex(P)^.Index[ParentIndex].Child;
            Result := False;
          end;
        end else begin
          Value := ExtractData(P, Index);
          if P^.Count < KData then
            if P <> Root then
              Underflow(Parent, P, ParentIndex)
            else if Count = 0 then
              Clear;
        end
      else if P^.IsIndex then begin
        if (P^.Count < KIndex) and (P <> Root) then
          Underflow(Parent, P, ParentIndex, Index);
        ParentIndex := Index;
        Parent := P;
        P := PIndex(P)^.Index[Index].Child;
      end else
        break; // give up
    until Result
end;

function TheCmpBTreeMap.Find(const P: PPage; const Key: TKey; out Index: Integer): Boolean;
type PKey = ^TKey;
var
  L, H, Cmp: Integer;
  MidKey: PKey;
  Mid: Integer absolute Index;
begin
  L := 0;
  H := P^.Count - 1;
  while L <= H do begin
    Mid := (L + H) shr 1;
    if P^.IsIndex then
      MidKey := @PIndex(P)^.Index[Mid].DataPage^.Data[0].Key
    else
      MidKey := @PData(P)^.Data[Mid].Key;
    Cmp := Compare(Key, Midkey^);
    if Cmp > 0 then
      L := Mid + 1
    else if Cmp = 0 then
      Exit(True)
    else
      H := Mid - 1;
  end;
  Index  := L;
  Result := False;
end;

function TheCmpBTreeMap.GetCurrent(var Iterator: TIterator): TValue;
begin
  Result := Iterator.Page^.Data[Iterator.Index].Value;
end;

function TheCmpBTreeMap.GetCurrentKey(var Iterator: TIterator): TKey;
begin
  Result := Iterator.Page^.Data[Iterator.Index].Key;
end;

function TheCmpBTreeMap.GetFirst: TValue;
begin
  Assert(Count <> 0);
  Result := PData(FFirst)^.Data[0].Value;
end;

function TheCmpBTreeMap.GetFirstKey: TKey;
begin
  Assert(Count <> 0);
  Result := PData(FFirst)^.Data[0].Key;
end;

function TheCmpBTreeMap.GetLast: TValue;
begin
  Assert(Count <> 0);
  Result := PData(FLast)^.Data[FLast^.Count - 1].Value;
end;

function TheCmpBTreeMap.GetLastKey: TKey;
begin
  Assert(Count <> 0);
  Result := PData(FLast)^.Data[FLast^.Count - 1].Key;
end;

function TheCmpBTreeMap.GetMap(const Key: TKey): TValue;
begin
  if not Get(Key, Result) then
    Result := MissingKeyValue(Key);
end;

function TheCmpBTreeMap.GetRange(const RangeFrom, RangeTo: TKey): TValueEnumeratorProvider;
var Iterator: TIterator;
begin
  Iterator.UseSentinel := True;
  Iterator.Sentinel := RangeTo;

  if Compare(RangeFrom, RangeTo) <= 0 then begin
    Seek(RangeFrom, Iterator.Page, Iterator.Index);
    Dec(Iterator.Index);
    Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrent);
    Exit;
  end;

  // RangeFrom > RangeTo
  if Seek(RangeFrom, Iterator.Page, Iterator.Index) and (Iterator.Index < PPage(Iterator.Page)^.Count) then
    Inc(Iterator.Index);
  Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrent);
end;

function TheCmpBTreeMap.GetRangeKeys(const RangeFrom, RangeTo: TKey): TKeyEnumeratorProvider;
var Iterator: TIterator;
begin
  Iterator.UseSentinel := True;
  Iterator.Sentinel := RangeTo;

  if Compare(RangeFrom, RangeTo) <= 0 then begin
    Seek(RangeFrom, Iterator.Page, Iterator.Index);
    Dec(Iterator.Index);
    Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrentKey);
    Exit;
  end;

  // RangeFrom > RangeTo
  if Seek(RangeFrom, Iterator.Page, Iterator.Index) and (Iterator.Index < PPage(Iterator.Page)^.Count) then
    Inc(Iterator.Index);
  Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrentKey);
end;

function TheCmpBTreeMap.Get(const Key: TKey; out Value: TValue): Boolean;
var
  P: PPage;
  Index: Integer;
begin
  Result := False;
  P := Root;
  if P <> nil then // tree is non empty
    repeat
      Result := Find(P, Key, Index);
      if Result then // Key found
        if P^.IsIndex then
          Value := PIndex(P)^.Index[Index].DataPage^.Data[0].Value
        else
          Value := PData(P)^.Data[Index].Value
      else if P^.IsIndex then
        P := PIndex(P)^.Index[Index].Child
      else
        break; // give up
    until Result;
end;

function TheCmpBTreeMap.Insert(const P: PPage; const Index: Integer): PPage;
begin
  if Index < P^.Count then
    if P^.IsIndex then
      Move(PIndex(P)^.Index[Index].DataPage, PIndex(P)^.Index[Index + 1].DataPage, (P^.Count - Index) * 2 * SizeOf(Pointer))
    else
      Move(PData(P)^.Data[Index], PData(P)^.Data[Index + 1], (P^.Count - Index) * SizeOf(PData(P)^.Data[0]));
  Inc(P^.Count);
  Result := P;
end;

function TheCmpBTreeMap.Insert(const P: PPage; const Index: Integer; const DataPage, Child: PPage): PPage;
begin
  Result := Insert(P, Index);
  PIndex(Result)^.Index[Index].DataPage := PData(DataPage);
  PIndex(Result)^.Index[Index + 1].Child := Child;
end;

function TheCmpBTreeMap.InsertItem(const P: PPage; const Index: Integer; const Key: TKey; const Value: TValue): PPage;
begin
  Result := Insert(P, Index);
  Initialize(PData(P)^.Data[Index]);
  PData(P)^.Data[Index].Key := Key;
  PData(P)^.Data[Index].Value := Value;
  Inc(FCount);
end;

procedure TheCmpBTreeMap.MoveLeft(const Left, P: PPage; const N: Integer);
begin
  Move(PData(P)^.Data[0], PData(Left)^.Data[Left^.Count], N * SizeOf(PData(P)^.Data[0]));
  Move(PData(P)^.Data[N], PData(P)^.Data[0], (P^.Count - N) * SizeOf(PData(P)^.Data[0]));
  Left^.Count += N;
  P^.Count -= N;
end;

function TheCmpBTreeMap.MoveNext(var Iterator: TIterator): Boolean;
begin
  while Iterator.Page <> nil do begin
    Inc(Iterator.Index);
    if Iterator.Index < PPage(Iterator.Page)^.Count then
      Exit(not Iterator.UseSentinel or (Compare(Iterator.Page^.Data[Iterator.Index].Key, Iterator.Sentinel) <= 0));
    Iterator.Page := Iterator.Page^.Next;
    Iterator.Index := -1;
  end;
  Result := False;
end;

function TheCmpBTreeMap.MovePrev(var Iterator: TIterator): Boolean;
begin
  while Iterator.Page <> nil do begin
    Dec(Iterator.Index);
    if Iterator.Index >= 0 then
      Exit(not Iterator.UseSentinel or (Compare(Iterator.Page^.Data[Iterator.Index].Key, Iterator.Sentinel) >= 0));
    Iterator.Page := Iterator.Page^.Prev;
    if Iterator.Page <> nil then
      Iterator.Index := PPage(Iterator.Page)^.Count;
  end;
  Result := False;
end;

procedure TheCmpBTreeMap.MoveRight(const P, Right: PPage; const N: Integer);
begin
  Move(PData(Right)^.Data[0], PData(Right)^.Data[N], Right^.Count * SizeOf(PData(P)^.Data[0]));
  Move(PData(P)^.Data[P^.Count - N], PData(Right)^.Data[0], N * SizeOf(PData(P)^.Data[0]));
  Right^.Count += N;
  P^.Count -= N;
end;

procedure TheCmpBTreeMap.Overflow(const Parent, P: PPage; const ParentIndex, Index: Integer; const Key: TKey; const Value: TValue);
var Left, Right: PPage;
begin
  CheckSiblings(Parent, ParentIndex, Left, Right);

  if (Left <> nil) and (Left^.Count < 2 * KData) then begin
    MoveLeft(Left, P);
    InsertItem(P, Index - 1, Key, Value);
    Exit;
  end;

  if (Right <> nil) and (Right^.Count < 2 * KData) then begin
    if Index < 2 * KData then begin
      MoveRight(P, Right);
      InsertItem(P, Index, Key, Value)
    end else
      InsertItem(Right, 0, Key, Value);
    Exit;
  end;

  SplitData(Parent, P, ParentIndex, Index, Key, Value);
end;

procedure TheCmpBTreeMap.SetMap(const Key: TKey; const Value: TValue);
begin
  Put(Key, Value);
end;

function TheCmpBTreeMap.Page(const IsIndex: Boolean; const LeftmostChild: PPage): PPage;
begin
  if IsIndex then begin
    GetMem(Result, SizeOf(TPage.Count) + SizeOf(TPage.IsIndex) + (4 * KIndex + 3) * SizeOf(Pointer));
    PIndex(Result)^.Index[0].Child := LeftmostChild;
  end else begin
    GetMem(Result, SizeOf(TPage.Count) + SizeOf(TPage.IsIndex) + 2 * SizeOf(Pointer) +  2 * KData * SizeOf(TDataPage.Data[0]));
    PData(Result)^.Prev := nil;
    PData(Result)^.Next := nil;
  end;
  Result^.IsIndex := IsIndex;
  Result^.Count := 0;
end;

function TheCmpBTreeMap.Seek(const Key: TKey; out P: PData; out Index: Integer): Boolean;
begin
  Result := False;
  P := PData(Root);
  if P <> nil then begin // tree is non empty
    repeat
      Result := Find(PPage(P), Key, Index);
      if Result then begin // Key found
        if PPage(P)^.IsIndex then begin
          P := PIndex(P)^.Index[Index].DataPage;
          Index := 0;
        end;
      end else if PPage(P)^.IsIndex then
        P := PData(PIndex(P)^.Index[Index].Child)
      else
        break;
    until Result;
  end;
end;

function TheCmpBTreeMap.Put(const Key: TKey; const Value: TValue; const CanOverwrite: Boolean): Boolean;
var Dummy: TValue;
begin
  Result := Put(Key, Value, Dummy, CanOverwrite);
end;

function TheCmpBTreeMap.Put(const Key: TKey; const Value: TValue; out Prev: TValue; const CanOverwrite: Boolean): Boolean;
var
  P, Parent: PPage;
  Index, ParentIndex: Integer;
begin
  Result := False;
  ParentIndex := -1;
  Parent := nil;
  P := Root;
  if P <> nil then
    repeat
      Result := Find(P, Key, Index);
      if Result then // Key found
        if P^.IsIndex then
          Swap(PIndex(P)^.Index[Index].DataPage^.Data[0].Value, Value, Prev, CanOverwrite)
        else
          Swap(PData(P)^.Data[Index].Value, Value, Prev, CanOverwrite)
      else if P^.IsIndex then begin
        if P^.Count > 2 * KIndex then
          SplitIndex(Parent, P, ParentIndex, Index);
        ParentIndex := Index;
        Parent := P;
        P := PIndex(P)^.Index[Index].Child
      end else begin
        if P^.Count < 2 * KData then // page is not full
          InsertItem(P, Index, Key, Value)
        else // page is full
          Overflow(Parent, P, ParentIndex, Index, Key, Value);
        break;
      end;
    until Result
  else begin // tree is empty
    FRoot := InsertItem(Page(False), 0, Key, Value);
    FFirst := Root;
    FLast := Root;
  end;
end;

function TheCmpBTreeMap.Keys: TKeyEnumeratorProvider;
var Iterator: TIterator;
begin
  Iterator.Page := PData(FFirst);
  Iterator.Index := -1;
  Iterator.UseSentinel := False;
  Assert(Iterator.Page = Iterator.Page); // hint off
  Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrentKey);
end;

function TheCmpBTreeMap.KeysReversed: TKeyEnumeratorProvider;
var Iterator: TIterator;
begin
  Iterator.Page := PData(FLast);
  Iterator.UseSentinel := False;
  if FLast <> nil then
    Iterator.Index := FLast^.Count;
  Assert(Iterator.Page = Iterator.Page); // hint off
  Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrentKey);
end;

function TheCmpBTreeMap.Values: TValueEnumeratorProvider;
var Iterator: TIterator;
begin
  Iterator.Page := PData(FFirst);
  Iterator.Index := -1;
  Iterator.UseSentinel := False;
  Assert(Iterator.Page = Iterator.Page); // hint off
  Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrent);
end;

function TheCmpBTreeMap.ValuesReversed: TValueEnumeratorProvider;
var Iterator: TIterator;
begin
  Iterator.Page := PData(FLast);
  Iterator.UseSentinel := False;
  if FLast <> nil then
    Iterator.Index := FLast^.Count;
  Assert(Iterator.Page = Iterator.Page); // hint off
  Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrent);
end;

procedure TheCmpBTreeMap.SplitData(const Parent, P: PPage; const ParentIndex, Index: Integer; const Key: TKey; const Value: TValue);
var Right: PPage;
begin
  Right := Page(False);
  if PData(P)^.Next <> nil then begin // P was not last
    PData(Right)^.Next := PData(P)^.Next;
    PData(Right)^.Next^.Prev := PData(Right);
  end else  // P was last
    FLast := Right;
  PData(P)^.Next := PData(Right);
  PData(Right)^.Prev := PData(P);
  Move(PData(P)^.Data[KData], PData(Right)^.Data[0], KData * SizeOf(PData(P)^.Data[0]));
  P^.Count := KData;
  Right^.Count := KData;
  if ParentIndex >= 0 then
    Insert(Parent, ParentIndex, Right, Right)
  else
    FRoot := Insert(Page(True, P), 0, Right, Right);
  if Index > KData then
    InsertItem(Right, Index - KData, Key, Value)
  else
    InsertItem(P, Index, Key, Value);
end;

procedure TheCmpBTreeMap.SplitIndex(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
var Right: PPage;
begin
  Right := Page(True);
  Move(PIndex(P)^.Index[KIndex + 1], PIndex(Right)^.Index[0], (2 * KIndex + 1) * SizeOf(Pointer));
  P^.Count := KIndex;
  Right^.Count := KIndex;
  if ParentIndex >= 0 then
    Insert(Parent, ParentIndex, PPage(PIndex(P)^.Index[KIndex].DataPage), Right)
  else
    FRoot := Insert(Page(True, P), 0, PPage(PIndex(P)^.Index[KIndex].DataPage), Right);
  if Index > KIndex then begin
    P := Right;
    Index -= KIndex + 1;
  end;
end;

procedure TheCmpBTreeMap.Swap(var Dest: TValue; const Value: TValue; out Prev: TValue; const CanOverwrite: Boolean);
begin
  Prev := Dest;
  if CanOverwrite then
    Dest := Value;
end;

procedure TheCmpBTreeMap.Underflow(const Parent, P: PPage; const ParentIndex: Integer);
var Left, Right: PPage;
begin
  CheckSiblings(Parent, ParentIndex, Left, Right);
  if (Left <> nil) and (Left^.Count + P^.Count >= 2 * KData) then
    MoveRight(Left, P)
  else if (Right <> nil) and (P^.Count + Right^.Count >= 2 * KData) then
    MoveLeft(P, Right)
  else if Left <> nil then
    Concat(Parent, Left, P, ParentIndex - 1)
  else
    Concat(Parent, P, Right, ParentIndex);
end;

procedure TheCmpBTreeMap.Underflow(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
var Left, Right: PPage;
begin
  CheckSiblings(Parent, ParentIndex, Left, Right);

  if (Left <> nil) and (Left^.Count > KIndex) then begin
    Move(PIndex(P)^.Index[0], PIndex(P)^.Index[1], (2 * P^.Count + 1) * SizeOf(Pointer));
    PIndex(P)^.Index[0].Child := PIndex(Left)^.Index[Left^.Count].Child;
    PIndex(P)^.Index[0].DataPage := PIndex(Parent)^.Index[ParentIndex - 1].DataPage;
    P^.Count += 1;
    Index += 1;
    Left^.Count -= 1;
    PIndex(Parent)^.Index[ParentIndex - 1].DataPage := PIndex(Left)^.Index[Left^.Count].DataPage;
    Exit;
  end;

  if (Right <> nil) and (Right^.Count > KIndex) then begin
    PIndex(P)^.Index[P^.Count].DataPage := PIndex(Parent)^.Index[ParentIndex].DataPage;
    P^.Count += 1;
    PIndex(P)^.Index[P^.Count].Child := PIndex(Right)^.Index[0].Child;
    PIndex(Parent)^.Index[ParentIndex].DataPage := PIndex(Right)^.Index[0].DataPage;
    Move(PIndex(Right)^.Index[1], PIndex(Right)^.Index[0], (2 * Right^.Count + 1) * SizeOf(Pointer));
    Right^.Count -= 1;
    Exit;
  end;

  if Left <> nil then begin
    Index += Left^.Count + 1;
    ConcatIndex(Parent, Left, P, ParentIndex - 1);
    P := Left;
    Exit;
  end;

  ConcatIndex(Parent, P, Right, ParentIndex);
end;

function TheCmpBTreeMap.MissingKeyValue(const Key: TKey): TValue;
begin
  Assert(@Key = @Key); // hint off
  Initialize(Result); // hint off
  raise EMapKeyNotFound.Create(ClassName);
end;

{ TheObjectBTreeMap }

procedure TheObjectBTreeMap.CheckSiblings(const Parent: PPage; const ParentIndex: Integer; out Left, Right: PPage);
begin
  Left := nil;
  Right := nil;
  if ParentIndex >= 0 then begin
    if ParentIndex > 0 then
      Left := PIndex(Parent)^.Index[ParentIndex - 1].Child;
    if ParentIndex < Parent^.Count then
      Right := PIndex(Parent)^.Index[ParentIndex + 1].Child;
  end;
end;

procedure TheObjectBTreeMap.Clear;
begin
  if Root <> nil then begin
    Clear(Root);
    FCount := 0;
    FFirst := nil;
    FLast := nil;
    FRoot  := nil;
  end;
end;

procedure TheObjectBTreeMap.Clear(const P: PPage);
var I: Integer;
begin
  if P^.IsIndex then
    for I := 0 to P^.Count do // Count=n Ch0 Med0 ... Chn-1 Medn-1 Chn
      Clear(PIndex(P)^.Index[I].Child)
  else begin
    for I := 0 to P^.Count - 1 do
      Finalize(PData(P)^.Data[I].Key);
    if OwnObjects then
      for I := 0 to P^.Count - 1 do
        PData(P)^.Data[I].Value.Free;
  end;
  FreeMem(P);
end;

procedure TheObjectBTreeMap.Concat(const Parent, P, Right: PPage; const ParentIndex: Integer);
begin
  MoveLeft(P, Right, Right^.Count);
  if PData(Right)^.Next <> nil then
    PData(Right)^.Next^.Prev := PData(P)
  else
    FLast := P;
  PData(P)^.Next := PData(Right)^.Next;
  FreeMem(Right);
  if Parent^.Count > 1 then begin
    ExtractIndex(Parent, ParentIndex);
    PIndex(Parent)^.Index[ParentIndex].Child := P;
  end else begin
    FreeMem(Root);
    FRoot := P;
  end;
end;

procedure TheObjectBTreeMap.ConcatIndex(const Parent, P, Right: PPage; const ParentIndex: Integer);
begin
  PIndex(P)^.Index[P^.Count].DataPage := PIndex(Parent)^.Index[ParentIndex].DataPage;
  Move(PIndex(Right)^.Index[0], PIndex(P)^.Index[P^.Count + 1], (2 * Right^.Count + 1) * SizeOf(Pointer));
  P^.Count += Right^.Count + 1;
  FreeMem(Right);
  if Parent^.Count > 1 then begin
    Parent^.Count -= 1;
    if ParentIndex < Parent^.Count then
      Move(
        PIndex(Parent)^.Index[ParentIndex + 1].DataPage,
        PIndex(Parent)^.Index[ParentIndex].DataPage,
        2 * (Parent^.Count - ParentIndex) * SizeOf(Pointer)
      );
  end else begin
    FreeMem(Root);
    FRoot := P;
  end;
end;

constructor TheObjectBTreeMap.Create(const AOwnObjects: Boolean; const AKIndex: Integer; const AKData: Integer);
begin
  inherited Create;
  FOwnObjects := AOwnObjects;
  FKIndex := Max(AKIndex, 2);
  FKData := Max(AKData, 1);
end;

function TheObjectBTreeMap.Delete(const Key: TKey): Boolean;
var Dummy: TValue;
begin
  Result := Extract(Key, Dummy);
end;

destructor TheObjectBTreeMap.Destroy;
begin
  Clear;
  inherited Destroy;
end;

function TheObjectBTreeMap.Compare(const A, B: TKey): Integer;
begin
  Result := 0; // hint off
  Assert(@A = @A); // hint off
  Assert(@B = @B); // hint off
  raise EAbstractError.Create(Format('%s.Compare', [ClassName]));
end;

function TheObjectBTreeMap.ExtractData(const P: PPage; const Index: Integer): TValue;
begin
  Result := PData(P)^.Data[Index].Value;
  Finalize(PData(P)^.Data[Index].Key);
  P^.Count -= 1;
  if Index < P^.Count then
    Move(PData(P)^.Data[Index + 1], PData(P)^.Data[Index], (P^.Count - Index) * SizeOf(PData(P)^.Data[0]));
  FCount -=1;
end;

procedure TheObjectBTreeMap.ExtractIndex(const P: PPage; const Index: Integer);
begin
  P^.Count -= 1;
  if Index < P^.Count then
    Move(PIndex(P)^.Index[Index + 1], PIndex(P)^.Index[Index], ((P^.Count - Index) * 2 + 1) * SizeOf(Pointer));
end;

function TheObjectBTreeMap.Extract(const Key: TKey; out Value: TValue): Boolean;
var
  Parent, P, DataPage: PPage;
  Index, ParentIndex: Integer;
begin
  Result := False;
  ParentIndex := -1;
  Parent := nil;
  P := Root;
  if P <> nil then
    repeat
      Result := Find(P, Key, Index);
      if Result then // Key found
        if P^.IsIndex then begin
          DataPage := PPage(PIndex(P)^.Index[Index].DataPage);
          if DataPage^.Count > KData then
            Value := ExtractData(DataPage, 0)
          else begin
            if (P^.Count < KIndex) and (P <> Root) then
              Underflow(Parent, P, ParentIndex, Index);
            ParentIndex := Index + 1;
            Parent := P;
            P := PIndex(P)^.Index[ParentIndex].Child;
            Result := False;
          end;
        end else begin
          Value := ExtractData(P, Index);
          if P^.Count < KData then
            if P <> Root then
              Underflow(Parent, P, ParentIndex)
            else if Count = 0 then
              Clear;
        end
      else if P^.IsIndex then begin
        if (P^.Count < KIndex) and (P <> Root) then
          Underflow(Parent, P, ParentIndex, Index);
        ParentIndex := Index;
        Parent := P;
        P := PIndex(P)^.Index[Index].Child;
      end else
        break; // give up
    until Result
end;

function TheObjectBTreeMap.Find(const P: PPage; const Key: TKey; out Index: Integer): Boolean;
type PKey = ^TKey;
var
  L, H, Cmp: Integer;
  MidKey: PKey;
  Mid: Integer absolute Index;
begin
  L := 0;
  H := P^.Count - 1;
  while L <= H do begin
    Mid := (L + H) shr 1;
    if P^.IsIndex then
      MidKey := @PIndex(P)^.Index[Mid].DataPage^.Data[0].Key
    else
      MidKey := @PData(P)^.Data[Mid].Key;
    Cmp := Compare(Key, Midkey^);
    if Cmp > 0 then
      L := Mid + 1
    else if Cmp = 0 then
      Exit(True)
    else
      H := Mid - 1;
  end;
  Index  := L;
  Result := False;
end;

function TheObjectBTreeMap.GetCurrent(var Iterator: TIterator): TValue;
begin
  Result := Iterator.Page^.Data[Iterator.Index].Value;
end;

function TheObjectBTreeMap.GetCurrentKey(var Iterator: TIterator): TKey;
begin
  Result := Iterator.Page^.Data[Iterator.Index].Key;
end;

function TheObjectBTreeMap.GetFirst: TValue;
begin
  Assert(Count <> 0);
  Result := PData(FFirst)^.Data[0].Value;
end;

function TheObjectBTreeMap.GetFirstKey: TKey;
begin
  Assert(Count <> 0);
  Result := PData(FFirst)^.Data[0].Key;
end;

function TheObjectBTreeMap.GetLast: TValue;
begin
  Assert(Count <> 0);
  Result := PData(FLast)^.Data[FLast^.Count - 1].Value;
end;

function TheObjectBTreeMap.GetLastKey: TKey;
begin
  Assert(Count <> 0);
  Result := PData(FLast)^.Data[FLast^.Count - 1].Key;
end;

function TheObjectBTreeMap.GetMap(const Key: TKey): TValue;
begin
  if not Get(Key, Result) then
    Result := MissingKeyValue(Key);
end;

function TheObjectBTreeMap.GetRange(const RangeFrom, RangeTo: TKey): TValueEnumeratorProvider;
var Iterator: TIterator;
begin
  Iterator.UseSentinel := True;
  Iterator.Sentinel := RangeTo;

  if Compare(RangeFrom, RangeTo) <= 0 then begin
    Seek(RangeFrom, Iterator.Page, Iterator.Index);
    Dec(Iterator.Index);
    Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrent);
    Exit;
  end;

  // RangeFrom > RangeTo
  if Seek(RangeFrom, Iterator.Page, Iterator.Index) and (Iterator.Index < PPage(Iterator.Page)^.Count) then
    Inc(Iterator.Index);
  Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrent);
end;

function TheObjectBTreeMap.GetRangeKeys(const RangeFrom, RangeTo: TKey): TKeyEnumeratorProvider;
var Iterator: TIterator;
begin
  Iterator.UseSentinel := True;
  Iterator.Sentinel := RangeTo;

  if Compare(RangeFrom, RangeTo) <= 0 then begin
    Seek(RangeFrom, Iterator.Page, Iterator.Index);
    Dec(Iterator.Index);
    Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrentKey);
    Exit;
  end;

  // RangeFrom > RangeTo
  if Seek(RangeFrom, Iterator.Page, Iterator.Index) and (Iterator.Index < PPage(Iterator.Page)^.Count) then
    Inc(Iterator.Index);
  Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrentKey);
end;

function TheObjectBTreeMap.Get(const Key: TKey; out Value: TValue): Boolean;
var
  P: PPage;
  Index: Integer;
begin
  Result := False;
  P := Root;
  if P <> nil then // tree is non empty
    repeat
      Result := Find(P, Key, Index);
      if Result then // Key found
        if P^.IsIndex then
          Value := PIndex(P)^.Index[Index].DataPage^.Data[0].Value
        else
          Value := PData(P)^.Data[Index].Value
      else if P^.IsIndex then
        P := PIndex(P)^.Index[Index].Child
      else
        break; // give up
    until Result;
end;

function TheObjectBTreeMap.Insert(const P: PPage; const Index: Integer): PPage;
begin
  if Index < P^.Count then
    if P^.IsIndex then
      Move(PIndex(P)^.Index[Index].DataPage, PIndex(P)^.Index[Index + 1].DataPage, (P^.Count - Index) * 2 * SizeOf(Pointer))
    else
      Move(PData(P)^.Data[Index], PData(P)^.Data[Index + 1], (P^.Count - Index) * SizeOf(PData(P)^.Data[0]));
  Inc(P^.Count);
  Result := P;
end;

function TheObjectBTreeMap.Insert(const P: PPage; const Index: Integer; const DataPage, Child: PPage): PPage;
begin
  Result := Insert(P, Index);
  PIndex(Result)^.Index[Index].DataPage := PData(DataPage);
  PIndex(Result)^.Index[Index + 1].Child := Child;
end;

function TheObjectBTreeMap.InsertItem(const P: PPage; const Index: Integer; const Key: TKey; const Value: TValue): PPage;
begin
  Result := Insert(P, Index);
  Initialize(PData(P)^.Data[Index].Key);
  PData(P)^.Data[Index].Key := Key;
  PData(P)^.Data[Index].Value := Value;
  Inc(FCount);
end;

procedure TheObjectBTreeMap.MoveLeft(const Left, P: PPage; const N: Integer);
begin
  Move(PData(P)^.Data[0], PData(Left)^.Data[Left^.Count], N * SizeOf(PData(P)^.Data[0]));
  Move(PData(P)^.Data[N], PData(P)^.Data[0], (P^.Count - N) * SizeOf(PData(P)^.Data[0]));
  Left^.Count += N;
  P^.Count -= N;
end;

function TheObjectBTreeMap.MoveNext(var Iterator: TIterator): Boolean;
begin
  while Iterator.Page <> nil do begin
    Inc(Iterator.Index);
    if Iterator.Index < PPage(Iterator.Page)^.Count then
      Exit(not Iterator.UseSentinel or (Compare(Iterator.Page^.Data[Iterator.Index].Key, Iterator.Sentinel) <= 0));
    Iterator.Page := Iterator.Page^.Next;
    Iterator.Index := -1;
  end;
  Result := False;
end;

function TheObjectBTreeMap.MovePrev(var Iterator: TIterator): Boolean;
begin
  while Iterator.Page <> nil do begin
    Dec(Iterator.Index);
    if Iterator.Index >= 0 then
      Exit(not Iterator.UseSentinel or (Compare(Iterator.Page^.Data[Iterator.Index].Key, Iterator.Sentinel) >= 0));
    Iterator.Page := Iterator.Page^.Prev;
    if Iterator.Page <> nil then
      Iterator.Index := PPage(Iterator.Page)^.Count;
  end;
  Result := False;
end;

procedure TheObjectBTreeMap.MoveRight(const P, Right: PPage; const N: Integer);
begin
  Move(PData(Right)^.Data[0], PData(Right)^.Data[N], Right^.Count * SizeOf(PData(P)^.Data[0]));
  Move(PData(P)^.Data[P^.Count - N], PData(Right)^.Data[0], N * SizeOf(PData(P)^.Data[0]));
  Right^.Count += N;
  P^.Count -= N;
end;

procedure TheObjectBTreeMap.Overflow(const Parent, P: PPage; const ParentIndex, Index: Integer; const Key: TKey; const Value: TValue);
var Left, Right: PPage;
begin
  CheckSiblings(Parent, ParentIndex, Left, Right);

  if (Left <> nil) and (Left^.Count < 2 * KData) then begin
    MoveLeft(Left, P);
    InsertItem(P, Index - 1, Key, Value);
    Exit;
  end;

  if (Right <> nil) and (Right^.Count < 2 * KData) then begin
    if Index < 2 * KData then begin
      MoveRight(P, Right);
      InsertItem(P, Index, Key, Value)
    end else
      InsertItem(Right, 0, Key, Value);
    Exit;
  end;

  SplitData(Parent, P, ParentIndex, Index, Key, Value);
end;

procedure TheObjectBTreeMap.SetMap(const Key: TKey; const Value: TValue);
begin
  Put(Key, Value);
end;

function TheObjectBTreeMap.Page(const IsIndex: Boolean; const LeftmostChild: PPage): PPage;
begin
  if IsIndex then begin
    GetMem(Result, SizeOf(TPage.Count) + SizeOf(TPage.IsIndex) + (4 * KIndex + 3) * SizeOf(Pointer));
    PIndex(Result)^.Index[0].Child := LeftmostChild;
  end else begin
    GetMem(Result, SizeOf(TPage.Count) + SizeOf(TPage.IsIndex) + 2 * SizeOf(Pointer) +  2 * KData * SizeOf(TDataPage.Data[0]));
    PData(Result)^.Prev := nil;
    PData(Result)^.Next := nil;
  end;
  Result^.IsIndex := IsIndex;
  Result^.Count := 0;
end;

function TheObjectBTreeMap.Seek(const Key: TKey; out P: PData; out Index: Integer): Boolean;
begin
  Result := False;
  P := PData(Root);
  if P <> nil then begin // tree is non empty
    repeat
      Result := Find(PPage(P), Key, Index);
      if Result then begin // Key found
        if PPage(P)^.IsIndex then begin
          P := PIndex(P)^.Index[Index].DataPage;
          Index := 0;
        end;
      end else if PPage(P)^.IsIndex then
        P := PData(PIndex(P)^.Index[Index].Child)
      else
        break;
    until Result;
  end;
end;

function TheObjectBTreeMap.Put(const Key: TKey; const Value: TValue; const CanOverwrite: Boolean): Boolean;
var Dummy: TValue;
begin
  Result := Put(Key, Value, Dummy, CanOverwrite);
end;

function TheObjectBTreeMap.Put(const Key: TKey; const Value: TValue; out Prev: TValue; const CanOverwrite: Boolean): Boolean;
var
  P, Parent: PPage;
  Index, ParentIndex: Integer;
begin
  Result := False;
  ParentIndex := -1;
  Parent := nil;
  P := Root;
  if P <> nil then
    repeat
      Result := Find(P, Key, Index);
      if Result then // Key found
        if P^.IsIndex then
          Swap(PIndex(P)^.Index[Index].DataPage^.Data[0].Value, Value, Prev, CanOverwrite)
        else
          Swap(PData(P)^.Data[Index].Value, Value, Prev, CanOverwrite)
      else if P^.IsIndex then begin
        if P^.Count > 2 * KIndex then
          SplitIndex(Parent, P, ParentIndex, Index);
        ParentIndex := Index;
        Parent := P;
        P := PIndex(P)^.Index[Index].Child
      end else begin
        if P^.Count < 2 * KData then // page is not full
          InsertItem(P, Index, Key, Value)
        else // page is full
          Overflow(Parent, P, ParentIndex, Index, Key, Value);
        break;
      end;
    until Result
  else begin // tree is empty
    FRoot := InsertItem(Page(False), 0, Key, Value);
    FFirst := Root;
    FLast := Root;
  end;
end;

function TheObjectBTreeMap.Keys: TKeyEnumeratorProvider;
var Iterator: TIterator;
begin
  Iterator.Page := PData(FFirst);
  Iterator.Index := -1;
  Iterator.UseSentinel := False;
  Assert(Iterator.Page = Iterator.Page); // hint off
  Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrentKey);
end;

function TheObjectBTreeMap.KeysReversed: TKeyEnumeratorProvider;
var Iterator: TIterator;
begin
  Iterator.Page := PData(FLast);
  Iterator.UseSentinel := False;
  if FLast <> nil then
    Iterator.Index := FLast^.Count;
  Assert(Iterator.Page = Iterator.Page); // hint off
  Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrentKey);
end;

function TheObjectBTreeMap.Values: TValueEnumeratorProvider;
var Iterator: TIterator;
begin
  Iterator.Page := PData(FFirst);
  Iterator.Index := -1;
  Iterator.UseSentinel := False;
  Assert(Iterator.Page = Iterator.Page); // hint off
  Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrent);
end;

function TheObjectBTreeMap.ValuesReversed: TValueEnumeratorProvider;
var Iterator: TIterator;
begin
  Iterator.Page := PData(FLast);
  Iterator.UseSentinel := False;
  if FLast <> nil then
    Iterator.Index := FLast^.Count;
  Assert(Iterator.Page = Iterator.Page); // hint off
  Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrent);
end;

procedure TheObjectBTreeMap.SplitData(const Parent, P: PPage; const ParentIndex, Index: Integer; const Key: TKey; const Value: TValue);
var Right: PPage;
begin
  Right := Page(False);
  if PData(P)^.Next <> nil then begin // P was not last
    PData(Right)^.Next := PData(P)^.Next;
    PData(Right)^.Next^.Prev := PData(Right);
  end else  // P was last
    FLast := Right;
  PData(P)^.Next := PData(Right);
  PData(Right)^.Prev := PData(P);
  Move(PData(P)^.Data[KData], PData(Right)^.Data[0], KData * SizeOf(PData(P)^.Data[0]));
  P^.Count := KData;
  Right^.Count := KData;
  if ParentIndex >= 0 then
    Insert(Parent, ParentIndex, Right, Right)
  else
    FRoot := Insert(Page(True, P), 0, Right, Right);
  if Index > KData then
    InsertItem(Right, Index - KData, Key, Value)
  else
    InsertItem(P, Index, Key, Value);
end;

procedure TheObjectBTreeMap.SplitIndex(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
var Right: PPage;
begin
  Right := Page(True);
  Move(PIndex(P)^.Index[KIndex + 1], PIndex(Right)^.Index[0], (2 * KIndex + 1) * SizeOf(Pointer));
  P^.Count := KIndex;
  Right^.Count := KIndex;
  if ParentIndex >= 0 then
    Insert(Parent, ParentIndex, PPage(PIndex(P)^.Index[KIndex].DataPage), Right)
  else
    FRoot := Insert(Page(True, P), 0, PPage(PIndex(P)^.Index[KIndex].DataPage), Right);
  if Index > KIndex then begin
    P := Right;
    Index -= KIndex + 1;
  end;
end;

procedure TheObjectBTreeMap.Swap(var Dest: TValue; const Value: TValue; out Prev: TValue; const CanOverwrite: Boolean);
begin
  Prev := Dest;
  if CanOverwrite then
    Dest := Value;
end;

procedure TheObjectBTreeMap.Underflow(const Parent, P: PPage; const ParentIndex: Integer);
var Left, Right: PPage;
begin
  CheckSiblings(Parent, ParentIndex, Left, Right);
  if (Left <> nil) and (Left^.Count + P^.Count >= 2 * KData) then
    MoveRight(Left, P)
  else if (Right <> nil) and (P^.Count + Right^.Count >= 2 * KData) then
    MoveLeft(P, Right)
  else if Left <> nil then
    Concat(Parent, Left, P, ParentIndex - 1)
  else
    Concat(Parent, P, Right, ParentIndex);
end;

procedure TheObjectBTreeMap.Underflow(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
var Left, Right: PPage;
begin
  CheckSiblings(Parent, ParentIndex, Left, Right);

  if (Left <> nil) and (Left^.Count > KIndex) then begin
    Move(PIndex(P)^.Index[0], PIndex(P)^.Index[1], (2 * P^.Count + 1) * SizeOf(Pointer));
    PIndex(P)^.Index[0].Child := PIndex(Left)^.Index[Left^.Count].Child;
    PIndex(P)^.Index[0].DataPage := PIndex(Parent)^.Index[ParentIndex - 1].DataPage;
    P^.Count += 1;
    Index += 1;
    Left^.Count -= 1;
    PIndex(Parent)^.Index[ParentIndex - 1].DataPage := PIndex(Left)^.Index[Left^.Count].DataPage;
    Exit;
  end;

  if (Right <> nil) and (Right^.Count > KIndex) then begin
    PIndex(P)^.Index[P^.Count].DataPage := PIndex(Parent)^.Index[ParentIndex].DataPage;
    P^.Count += 1;
    PIndex(P)^.Index[P^.Count].Child := PIndex(Right)^.Index[0].Child;
    PIndex(Parent)^.Index[ParentIndex].DataPage := PIndex(Right)^.Index[0].DataPage;
    Move(PIndex(Right)^.Index[1], PIndex(Right)^.Index[0], (2 * Right^.Count + 1) * SizeOf(Pointer));
    Right^.Count -= 1;
    Exit;
  end;

  if Left <> nil then begin
    Index += Left^.Count + 1;
    ConcatIndex(Parent, Left, P, ParentIndex - 1);
    P := Left;
    Exit;
  end;

  ConcatIndex(Parent, P, Right, ParentIndex);
end;

function TheObjectBTreeMap.MissingKeyValue(const Key: TKey): TValue;
begin
  Assert(@Key = @Key); // hint off
  Initialize(Result); // hint off
  raise EMapKeyNotFound.Create(ClassName);
end;

end.