A generic HashMap, my crazy implementation...

Last but not least, my crazy implementation of a generic HashMap (aka dictionary), is crazy because I use TStrings for storing buckets, which give very fast access in any case...

The way HashMap works is like contacts in your movile device, they are stored as Name/Number (key/value) and the dispersion factor is the First letter (A...Z), in a hashmap you define the large your contact list is and how you store each entry, the "how" is the most  important, for instance, take 1000 entries, if your dispersion ratio is something like five, all your entries will be only inserted into five buckets...

bucket = Hash(aKey) mod SIZE;

Source can be found in BB.Collection.Hash

THashList<T: class> = class(TPooledObject, IIterator<T>)
  private
    FData: THashData;
    FCount: integer;
    FOwned: boolean;
    FBucket: integer;
    FIndex: integer;
    FSize: integer;

    function GetItem(aIndex: integer): T;
    procedure GetOffset(const aElement: integer; out aBucket, aIndex: integer);
    function GetKey(aIndex: integer): string;
    procedure SetSize(const aValue: integer);
    procedure Grow(aFrom: integer; aTo: integer);
  protected
    function FirstObject: T;
    function NextObject: T;
    function LastObject: T;
    function PriorObject: T;
    function GetCount: integer;
    function IsEmpty: boolean;
  public
    constructor Create(aSize: integer = DEFAULT_HASHMAP_SIZE); reintroduce;
    destructor Destroy; override;
    function Add(const aKey: string; aObject: T): integer; virtual;
    procedure Clear; override;
    procedure Rename(const aOldKey, aNewKey: string; aObject: T); overload;
    function Modify(const aKey: string; aObject: T): integer; overload; virtual;
    procedure Delete(const aKey: string);
    function IndexOf(const aKey: string): T; overload;
    function Find(const aPartialKey: string): T;
    function Sort: TStrings;
    function GetStatistics: TArrayOfInt;
    // IIterator
    function First: boolean;
    function Last: boolean;
    function Next: boolean;
    function GetCurrent: T;

    property Items[index: integer]: T read GetItem; default;
    property Keys[index: integer]: string read GetKey;
    property Owned: boolean read FOwned write FOwned;
    property Size: integer read FSize write SetSize;
    property Count: integer read GetCount;
  end;

Implementation:

 {THashList }

function THashList<T>.Add(const aKey: string; aObject: T): integer;
begin
  result := FData[TVar.GetHash(aKey) mod FSize].AddObject(aKey, aObject);

  Inc(FCount);
end;

procedure THashList<T>.Clear;
var
  i, j: integer;
  obj: T;
  l: TStringList;

begin
  inherited;

  for i := Low(FData) to High(FData) do
  begin
    l := FData[i];
    for j := FData[i].Count - 1 DownTo 0 do
    begin
      obj := l.Objects[j];
      if (obj <> nil) and (FOwned) then
        obj.Free;
    end;

    l.Clear;
  end;

  FCount := 0;
end;

function THashList<T>.GetCount: integer;
begin
  result := FCount;
end;

constructor THashList<T>.Create(aSize: integer = DEFAULT_HASHMAP_SIZE);
begin
  inherited Create;

  FOwned := False;
  FCount := 0;
  FBucket := -1;
  FIndex := -1;

  Grow( Low(FData), aSize);
end;

procedure THashList<T>.Delete(const aKey: string);
var
  bucket, i: integer;
  obj: T;
  l: TStringList;

begin
  bucket := TVar.GetHash(aKey) mod FSize;
  l := FData[bucket];
  i := l.IndexOf(aKey);
  obj := l.Objects[i];
  l.Delete(i);

  Dec(FCount);
  if FOwned then
    obj.Free;
end;

destructor THashList<T>.Destroy;
var
  i: integer;

begin
  Clear;
  for i := Low(FData) to High(FData) do
    FData[i].Free;

  inherited Destroy;
end;

function THashList<T>.Find(const aPartialKey: string): T;
var
  obj: T;
  key: string;

begin
  result := nil;
  obj := FirstObject;
  while obj <> nil do
  begin
    key := FData[FBucket].Strings[FIndex];
    if Pos(aPartialKey, key) > 0 then
    begin
      result := FData[FBucket].Objects[FIndex];
      Break;
    end;

    obj := NextObject;
  end;
end;

function THashList<T>.First: boolean;
begin
  result := FirstObject <> nil;
end;

function THashList<T>.FirstObject: T;
begin
  if IsEmpty then
  begin
    result := nil;
    Exit;
  end;

  FBucket := 0;
  while FData[FBucket].Count = 0 do
    Inc(FBucket);
  FIndex := 0;

  result := GetCurrent;
end;

function THashList<T>.GetCurrent: T;
begin
  if (FBucket > -1) and (FIndex < FData[FBucket].Count) then
    result := FData[FBucket].Objects[FIndex]
  else
    result := nil;
end;

function THashList<T>.GetItem(aIndex: integer): T;
var
  bucket, i: integer;

begin
  GetOffset(aIndex, bucket, i);
  result := FData[bucket].Objects[i];
end;

function THashList<T>.GetKey(aIndex: integer): string;
var
  bucket, i: integer;

begin
  GetOffset(aIndex, bucket, i);
  result := FData[bucket][i];
end;

procedure THashList<T>.GetOffset(const aElement: integer;
  out aBucket, aIndex: integer);
var
  total: integer;

begin
  total := 0;
  aBucket := 0;
  aIndex := aElement;
  while (total <= aElement) or (total = 0) do
  begin
    Inc(total, FData[aBucket].Count);
    Inc(aBucket);
  end;
  Dec(aBucket);

  Dec(total, FData[aBucket].Count);
  Dec(aIndex, total);
end;

function THashList<T>.IndexOf(const aKey: string): T;
var
  bucket, i: integer;
  l: TStringList;

begin
  bucket := TVar.GetHash(aKey) mod FSize;
  l := FData[bucket];
  i := l.IndexOf(aKey);
  if i > -1 then
    result := l.Objects[i]
  else
    result := nil;
end;

function THashList<T>.IsEmpty: boolean;
begin
  result := FCount = 0;
end;

function THashList<T>.Last: boolean;
begin
  result := LastObject <> nil;
end;

function THashList<T>.LastObject: T;
begin
  if IsEmpty then
  begin
    result := nil;
    Exit;
  end;

  FBucket := High(THashData);
  while FData[FBucket].Count = 0 do
    Dec(FBucket);
  FIndex := FData[FBucket].Count - 1;

  result := GetCurrent;
end;

function THashList<T>.Modify(const aKey: string; aObject: T): integer;
var
  bucket: integer;
  l: TStringList;

begin
  bucket := TVar.GetHash(aKey) mod FSize;
  l := FData[bucket];
  result := l.IndexOf(aKey);
  if result > -1 then
  begin
    if FOwned then
      l.Objects[result].Free;
    l.Objects[result] := aObject;
  end
  else
    result := Add(aKey, aObject);
end;

function THashList<T>.Next: boolean;
begin
  result := NextObject <> nil;
end;

function THashList<T>.NextObject: T;
begin
  if IsEmpty then
  begin
    result := nil;
    Exit;
  end;

  Inc(FIndex);
  if FIndex > FData[FBucket].Count - 1 then
  begin
    Inc(FBucket);
    while (FData[FBucket].Count = 0) and (FBucket < High(FData)) do
      Inc(FBucket);
    FIndex := 0;
  end;

  result := GetCurrent;
end;

function THashList<T>.PriorObject: T;
begin
  if IsEmpty then
  begin
    result := nil;
    Exit;
  end;

  Dec(FIndex);
  if FIndex < 0 then
  begin
    Inc(FBucket);
    while (FData[FBucket].Count = 0) and (FBucket > 0) do
      Dec(FBucket);
    FIndex := FData[FBucket].Count - 1;
  end;

  result := GetCurrent;
end;

procedure THashList<T>.SetSize(const aValue: integer);
begin
  if aValue < FSize then
    raise Exception.Create('Hash size can only grow');

  Grow(FSize + 1, aValue);
end;

function THashList<T>.Sort: TStrings;
var
  i, index, bucket: integer;

begin
  result := TStringList.Create;
  TStringList(result).Sorted := True;
  TStringList(result).Duplicates := dupError;

  for i := 0 to GetCount - 1 do
  begin
    GetOffset(i, bucket, index);
    result.AddObject(FData[bucket].Strings[index],
      FData[bucket].Objects[index]);
  end;
end;

function THashList<T>.GetStatistics: TArrayOfInt;
var
  i: integer;

begin
  SetLength(result, Length(FData));
  for i := Low(FData) to High(FData) do
    result[i] := FData[i].Count;
end;

procedure THashList<T>.Grow(aFrom: integer; aTo: integer);
var
  n: integer;

begin
  if aTo = 0 then
    raise Exception.Create('HashList size cannot be zero');

  FSize := aTo;
  SetLength(FData, FSize + 1);

  for n := Low(FData) to High(FData) do
  begin
    FData[n] := TStringList.Create;
    FData[n].Sorted := True;
    FData[n].Duplicates := dupError;
    FData[n].Capacity := 100;
  end;
end;

procedure THashList<T>.Rename(const aOldKey, aNewKey: string; aObject: T);
begin
  Delete(aOldKey);
  Add(aNewKey, aObject);
end;

The hash function looks like this:

class function TVar.GetHash(const aText: string): integer;
var
  i: Integer;

begin
  result := 5381;
  for i := 1 to Length(aText) do
    result := ((result shl 5) + result) + Ord(aText[i]);
//    result := result * 2 + n xor Ord(aText[n]);
end;
The comments means that I'm not happy with the dispersion ratio.

A generic pool

Sometimes under some circunstances, there is a heavy object allocation/deallocation which penalizes the performance quite a lot, a way of improving this issue is an object pool (very similar to a database connection pool). Our implementation resides in BB.Pool and defined in this way:

{$M+}

  TObjectPool<T: class, constructor> = class(TPooledObject, IPool<T>)
  private
    FBusy,
    FFree: TList<T>;
    FOnDataNeeded: TNotifyEvent;
    FCurrent: integer;
    FOnReleaseObject: TNotifyEvent;
    FUseGarbage: boolean;
    FTimeOut: cardinal;
    FOnGarbage: TGarbageNotify;
    FOnKillObject: TNotifyEvent;
    FGarbageSleep: cardinal;
    FOnException: TMessageException;
    FCapacity: cardinal;
    FOnLog: TPoolLog;
    FOnGetObject: TNotifyEvent;
    FLock: ILock;
    FOnCreateObject: TNotifyEvent;
    FOwnObjects: boolean;

    function GetFree(aIndex: integer): T;
    function GetItem(aIndex: integer): T;
    procedure SetPooled(aObject: T);
    procedure CheckNull(aObject: T);
    procedure CheckCapacity;
    procedure ClearObject(aObject: T);
  protected
    function CreateClass: T; virtual;
    procedure DoRelease(aObject: T); virtual;
    procedure DoDataNeeded(aObject: T); virtual;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure Clear; override;
    function Get: T; virtual;
    procedure Release(aObject: T);
    procedure ReleaseAll;
    procedure KillObject(aObject: T; aWaitGarbage: boolean = True);
    function Count: cardinal;
    function Used: integer;
    function NonUsed: integer;
    procedure Grow(aSize: cardinal);

    property FreeItems[index: integer]: T read GetFree;
    property UsedItems[index: integer]: T Read GetItem; default;
  published
    property Capacity: cardinal Read FCapacity Write FCapacity;
    property TimeOut: cardinal Read FTimeOut Write FTimeOut;
    property OnGetObject: TNotifyEvent Read FOnGetObject Write FOnGetObject;
    property OnException: TMessageException Read FOnException Write FOnException;
    property OnDataNeeded: TNotifyEvent Read FOnDataNeeded Write FOnDataNeeded;
    property OnReleaseObject: TNotifyEvent Read FOnReleaseObject Write FOnReleaseObject;
    property OnKillObject: TNotifyEvent Read FOnKillObject Write FOnKillObject;
    property OnCreateObject: TNotifyEvent read FOnCreateObject write FOnCreateObject;
    property OnLog: TPoolLog Read FOnLog Write FOnLog;
    property OwnObjects: boolean read FOwnObjects write FOwnObjects;
  end;
  {$M-}

Notice that there is a constraint in the generic, it can only be a class <T: class>, since the purpose is to store objects. The class can be used in a concurrent manner since it implements locking primitives.

Now the implementation:

{ TObjectPool<T> }

procedure TObjectPool<T>.Clear;
var
  i: integer;

begin
  inherited;

  FLock.Lock;
  try
    if FOwnObjects then
    begin
      for i := FFree.Count - 1 downto 0 do
        FFree[i].Free;
    end;
    FFree.Clear;

    if FOwnObjects then
    begin
      for i := FBusy.Count - 1 downto 0 do
        FBusy[i].Free;
    end;
    FBusy.Clear;
  finally
    FLock.UnLock;
  end;
end;

procedure TObjectPool<T>.ClearObject(aObject: T);
var
  I: IPoolable;

begin
  if aObject.GetInterface(IPoolable, I) then
    I.Clear;
end;

function TObjectPool<T>.Count: cardinal;
begin
  Result := FFree.Count + FBusy.Count;
end;

constructor TObjectPool<T>.Create;
begin
  inherited Create;

  FOnLog := nil;
  FOnDataNeeded := nil;
  FOnReleaseObject := nil;
  FOnGetObject := nil;
  FOnKillObject := nil;
  FOnCreateObject := nil;
  FCurrent := -1;
  FTimeOut := 3000;
  FUseGarbage := False;
  FGarbageSleep := 30000;
  FOnGarbage := nil;
  FOnException := nil;
  FOwnObjects := True;
  FCapacity := MaxLongint;
  FFree := TList<T>.Create;
  FBusy := TList<T>.Create;
  FLock := TCriticalLock.Create;
end;

destructor TObjectPool<T>.Destroy;
begin
  Clear;

  FFree.Free;
  FBusy.Free;
  FLock := nil;

  inherited Destroy;
end;

procedure TObjectPool<T>.DoDataNeeded(aObject: T);
begin
  if Assigned(FOnGetObject) then
    FOnGetObject(aObject);
end;

procedure TObjectPool<T>.DoRelease(aObject: T);
begin
  if Assigned(FOnReleaseObject) then
    FOnReleaseObject(aObject);
end;

function TObjectPool<T>.Used: integer;
begin
  Result := FBusy.Count;
end;

function TObjectPool<T>.GetFree(aIndex: integer): T;
begin
  result := FFree[aIndex];
end;

function TObjectPool<T>.GetItem(aIndex: integer): T;
begin
  Result := FBusy[aIndex];
end;

function TObjectPool<T>.Get: T;
var
  i: integer;

begin
  FLock.Lock;
  try
    i := FFree.Count - 1;
    if i >= 0 then
    begin  //At least there is one free object
      Result := GetFree(i);
      FBusy.Add(Result);
      FFree.Delete(i);
      ClearObject(result);
    end else
    begin
      CheckCapacity;

      result := CreateClass;
      FBusy.Add(result);
      SetPooled(result);
    end;

    DoDataNeeded(Result);
  finally
    FLock.UnLock;
  end;
end;

procedure TObjectPool<T>.Grow(aSize: cardinal);
var
  i: integer;
  l: TList<T>;

begin
  if Count + aSize > FCapacity then
    raise Exception.Create('Cannot grow more than capacity ' + IntToStr(FCapacity));

  FLock.Lock;
  try
    l := TList<T>.Create;
    try
      for i := 0 to aSize - 1 do
        l.Add(Get);
    finally
      for i := 0 to l.Count - 1 do
        Release(l[i]);
      l.Free;
    end;
  finally
    FLock.UnLock;
  end;
end;

procedure TObjectPool<T>.CheckCapacity;
begin
  if Count >= FCapacity then
    raise ETooManyObjects.Create('Maximum objects reached', []);
end;

procedure TObjectPool<T>.CheckNull(aObject: T);
begin
  if aObject = nil then
    raise Exception.Create('Nil object is not valid');
end;

procedure TObjectPool<T>.KillObject(aObject: T; aWaitGarbage: boolean = True);
var
  i: integer;

begin
  FLock.Lock;
  try
    CheckNull(aObject);
    { TODO : Wait for garbage }

    i := FBusy.IndexOf(aObject);
    if i > -1 then
      FBusy.Delete(i)
    else
    begin
      i := FFree.IndexOf(aObject);
      if i = -1 then
        raise Exception.Create('Object ' + aObject.ClassName + ' not in pool');
      FFree.Delete(i);
    end;

    if Assigned(FOnKillObject) then
      FOnKillObject(aObject);

    if FOwnObjects then
      aObject.Free;
  finally
    FLock.UnLock;
  end;
end;

procedure TObjectPool<T>.Release(aObject: T);
var
  item: T;

begin
  CheckNull(aObject);

  FLock.Lock;
  try
    item := FBusy.Extract(aObject);
    if item = nil then
      raise Exception.Create('Object ' + aObject.ClassName + ' not in pool');
    FFree.Add(item);

    DoRelease(aObject);
  finally
    FLock.UnLock;
  end;
end;

procedure TObjectPool<T>.ReleaseAll;
var
  i: integer;

begin
  FLock.Lock;
  try
    for i := FBusy.Count - 1 downto 0 do
      FFree.Add(FBusy[i]);
    FBusy.Clear;
  finally
    FLock.UnLock;
  end;
end;

function TObjectPool<T>.CreateClass: T;
begin
  Result := T.Create;

  if Assigned(FOnCreateObject) then
    FOnCreateObject(result);
end;

function TObjectPool<T>.NonUsed: integer;
begin
  Result := FFree.Count;
end;

procedure TObjectPool<T>.SetPooled(aObject: T);
var
  I: IPoolable;

begin
  if aObject.GetInterface(IPoolable, I) then
    I.SetPooled(True);
end;

The use is quite easy:

var
  pool: TObjectPool<TObject>;
  i: integer;
  obj: TObject;

begin
  pool := TObjectPool<TObject>.Create;
  //Although this loop counts 1000000 elements, only one object is created
  for i := 0 to 999999 do
  begin
    obj := pool.Get;  //Every Get() must have its own Release()
    pool.Release;
  end;
end;
A proper use can be located in the 3d engine, the polygon system is cached this way.

Generic Tree

Looks like today is the generic collection day, now is time for a generic tree, it is located in BB.Collection.Tree.Generic.

Tree are a very fast way of insert, add, delete and search, but for linear access is slow (or at least not as fast as other types), for pure maintenance is the best structure, but not the best for specific task (only add or only delete, etc)

It looks like this:

type
  TNode<T> = class
  private
    FLeft: TNode<T>;
    FParent: TNode<T>;
    FRight: TNode<T>;
    FData: T;
  public
    constructor Create; virtual;

    property Parent: TNode<T> Read FParent Write FParent;
    property Left: TNode<T> Read FLeft Write FLeft;
    property Right: TNode<T> Read FRight Write FRight;
    property Data: T Read FData Write FData;
  end;

  TTree<T> = class(TVar, ICollection<T>)
  private
    FRoot,
    FCurrent: TNode<T>;
    FCount: integer;
    FOwnObjects: boolean;
    FDuplicates: boolean;
    FPool: TObjectPool;
    FComparer: IEqualityComparer<T>;

    function Get(aIndex: integer): T;
    procedure Put(aIndex: integer; aObject: T);
    function GetCount: integer;
    function FirstItem: T;
    function NextItem: T;
    function PriorItem: T;
    function LastItem: T;
    procedure AddNode(var aNode: TNode<T>; aParent: TNode<T>; aObject: T; aCmp: IComparable);
    procedure TryFreeObject(aItem: T);
  public
    constructor Create; override;
    destructor Destroy; override;
    function IndexOf(aObject: T): integer;
    function Add(aObject: T): integer;  
    procedure Delete(aObject: T);
    procedure Clear(aExcept: T); reintroduce; overload;
    procedure Clear; overload; override;
    function Extract(aObject: T): T;
    procedure Insert(aObject: T; aWhere: integer); virtual;
    function Clone: TObject; override;
    //IIterator
    function First: boolean;
    function Last: boolean;
    function Next: boolean;
    function GetCurrent: T;

    property Count: integer read GetCount;
    property Current: TNode<T> Read FCurrent;
    property Items[index: integer]: T Read Get Write Put; default;
    property OwnObjects: boolean Read FOwnObjects Write FOwnObjects;
    property Duplicates: boolean Read FDuplicates Write FDuplicates;
  end;

We have typical iterators and maintenance

Generic queues

If you have read the previous post, discusses generic Linked List, in this post I will present you generic queues.

In the chess game, the board is stored in a LIFO<TBoard> queue, so you can play deeper and deeper and easily undo/redo the board state.

It can be found in BB.Collection.Queue

Interface:

TQueue<T> = abstract class(TInterfacedObject, IStack<T>)
  private
    FItems: TLinkedList<T>;
    FCapacity: cardinal;

    function DoPush(aItem: T): integer;
  protected
    procedure QueueEmpty;
    procedure SetCapacity(aValue: cardinal); virtual;
    function IsFull: boolean;
    function Last(out aItem: T): boolean;
    function First(out aItem: T): boolean;
  public
    constructor Create; overload; virtual;
    constructor Create(aCapacity: integer); overload;
    destructor Destroy; override;
    function Push(aItem: T): integer; overload; virtual;
    function Pop: T; virtual; abstract;
    function TryPop(out aItem: T): boolean;
    procedure Clear;
    function IsEmpty: boolean; inline;
    function Count: integer; inline;
    function Extract(aIndex: integer): T;
    procedure Remove(aItem: T);

    property Capacity: cardinal read FCapacity write SetCapacity;
  end;

  TLIFO<T> = class(TQueue<T>)
  public
    constructor Create; override;
    function Pop: T; override;
  end;

  TFIFO<T> = class(TQueue<T>)
  public
    constructor Create; override;
    function Pop: T; override;
  end;

  TCircularQueue<T> = class(TQueue<T>)
  public
    function Push(aItem: T): integer; override;
  end;

Again nothing special, the classes inherit from abstract class TQueue<T> and internally they use Linked List for storing the data.

Implementation:

{ TQueue }

procedure TQueue<T>.Clear;
begin
  FItems.Clear;
end;

function TQueue<T>.Count: integer;
begin
  result := FItems.Count;
end;

constructor TQueue<T>.Create(aCapacity: integer);
begin
  Create;
  FCapacity := aCapacity;
end;

constructor TQueue<T>.Create;
begin
  inherited Create;

  FItems := TLinkedList<T>.Create;
  FCapacity := INFINITE;
end;

destructor TQueue<T>.Destroy;
begin
  FItems.Free;

  inherited;
end;

function TQueue<T>.Extract(aIndex: integer): T;
begin
  result := FItems[aIndex];
  FItems.Delete(result);
end;

function TQueue<T>.First(out aItem: T): boolean;
begin
  result := FItems.First;
  if result then
    aItem := FItems.GetCurrent;
end;

function TQueue<T>.IsEmpty: boolean;
begin
  result := Count = 0;
end;

procedure TQueue<T>.QueueEmpty;
begin
  raise Exception.Create('Queue empty');
end;

procedure TQueue<T>.Remove(aItem: T);
begin
  FItems.Delete(aItem);
end;

function TQueue<T>.DoPush(aItem: T): integer;
begin
  FItems.Add(aItem);
  result := Count - 1;
end;

function TQueue<T>.IsFull: boolean;
begin
  result := cardinal(Count) >= FCapacity;
end;

function TQueue<T>.Last(out aItem: T): boolean;
begin
  result := FItems.Last;
  if result then
    aItem := FItems.GetCurrent;
end;

function TQueue<T>.Push(aItem: T): integer;
begin
  if IsFull then
    raise Exception.Create('The stack has reach its limit');
  result := DoPush(aItem);
end;

procedure TQueue<T>.SetCapacity(aValue: cardinal);
begin
  FCapacity := aValue;
end;

function TQueue<T>.TryPop(out aItem: T): boolean;
begin
  result := Count > 0;
  if result then
    aItem := Pop;
end;

{ TLIFO }

constructor TLIFO<T>.Create;
begin
  inherited;

  FItems.SearchType := stFromLast;
end;

function TLIFO<T>.Pop: T;
begin
  if not Last(result) then
    QueueEmpty;

  Remove(result);
end;

{ TFIFO }

constructor TFIFO<T>.Create;
begin
  inherited;

  FItems.SearchType := stFromFirst;
end;

function TFIFO<T>.Pop: T;
begin
  if not First(result) then
    QueueEmpty;

  Remove(result);
end;

{ TCircularQueue }

function TCircularQueue<T>.Push(aItem: T): integer;
begin
  if IsFull then
    Pop;
  result := DoPush(aItem);
end;

end.

Generic linked list

Today I will present my generic linked list, the advantage with them is:

• Insert or delete at any position is linear (compared with arrays that deleting the first element can be painful)
• Dynamic allocation

some cons:

• A bit complex to implement
• No constant time access since the elements are not stored linearly

Having a look at pros/cons I think a good way of using them are FIFO/LIFO queues, let's see the interface (it can be found at BB.Collection.List)

TLinkedList<T> = class(TInterfacedObject, ISorteable, IIterator<T>)
  private
    type
      TNodeList = class
      public
        Item: T;
        Next,
        Prior: TNodeList;
      end;

      TLinkedListEnum = record
      private
        FList: TLinkedList<T>;
        FFirst: boolean;

        function GetCurrent: T;
      public
        constructor Create(aList: TLinkedList<T>);
        function MoveNext: boolean;

        property Current: T read GetCurrent;
      end;

    var
      FIndexed,
      FHead,
      FTail: TNodeList;
      FCount: integer;
      FOwnObjects: boolean;
      FComparer: IComparer<T>;
      FSearchType: TSearchType;

    function GetItem(aIndex: integer): T;
    procedure SetItem(aIndex: integer; const aItem: T);
    procedure CheckIndex(aIndex: Integer);
    procedure TryFreeObject(aItem: T);
    function InternalFind(aItem: T): TNodeList;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Add(aItem: T);
    procedure Insert(aItem, aWhich: T);
    procedure Clear;
    function Count: integer; inline;
    procedure Delete(aItem: T);
    function GetEnumerator: TLinkedListEnum;
    procedure Sort;
    function Find(aItem: T): boolean;
    //IEnumerator
    function GetCurrent: T; inline;
    function First: boolean;
    function Next: boolean;
    function Last: boolean;

    property OwnObjects: boolean read FOwnObjects write FOwnObjects;
    property Items[aIndex: integer]: T read GetItem write SetItem; default; //Slow!!!
    property Comparer: IComparer<T> read FComparer write FComparer;
    property SearchType: TSearchType read FSearchType write FSearchType;
  end;

Nothing special, just maintenance, an enumerator and a property in case T is an object and you need to auto delete the objects and a flag that tells the class is the search starts from the head or from the tail (guess why),

Let's see the implementation:

{ TLinkedList<T> }

procedure TLinkedList<T>.Add(aItem: T);
var
  current: TNodeList;

begin
  //Create new node
  current := TNodeList.Create;
  current.Item := aItem;
  current.Prior := FTail;
  current.Next := nil;

  //Update head
  if FHead = nil then
    FHead := current;

  //Update tail node (previous node)
  if FTail <> nil then
    FTail.Next := current;
  //Tail always point to the last item added
  FTail := current;

  Inc(FCount);
end;

procedure TLinkedList<T>.Clear;
var
  current, tmp: TNodeList;

begin
  current := FHead;
  while current <> nil do
  begin
    TryFreeObject(current.Item);

    tmp := current;
    current := current.Next;
    tmp.Free;
  end;

  FHead := nil;
  FTail := nil;
  FIndexed := nil;
  FCount := 0;
end;

function TLinkedList<T>.Count: integer;
begin
  result := FCount;
end;

constructor TLinkedList<T>.Create;
begin
  FOwnObjects := True;
  FComparer := TComparer<T>.Default;
  FSearchType := stFromFirst;

  Clear;
end;

procedure TLinkedList<T>.Delete(aItem: T);
var
  current, prior, next: TNodeList;

begin
  current := InternalFind(aItem);
  if current = nil then
    raise Exception.Create('Item not found');

  prior := current.Prior;
  next := current.Next;

  TryFreeObject(current.Item);

  //Update head
  if FHead = current then
  begin
    if next <> nil then
      FHead := next
    else
      FHead := nil;
  end;

  //Update tail
  if FTail = current then
  begin
    if prior <> nil then
      FTail := prior
    else
      FTail := nil;
  end;

  //Update sides
  if prior <> nil then
    prior.Next := next;

  if next <> nil then
    next.Prior := prior;

  current.Free;
  Dec(FCount);
end;

destructor TLinkedList<T>.Destroy;
begin
  Clear;

  inherited;
end;

function TLinkedList<T>.Find(aItem: T): boolean;
begin
  result := InternalFind(aItem) <> nil;
end;

function TLinkedList<T>.First: boolean;
begin
  result := FCount > 0;
  if result then
    FIndexed := FHead;
end;

procedure TLinkedList<T>.TryFreeObject(aItem: T);
var
  v: TValue;

begin
  if FOwnObjects then
  begin
    v := TValue.From<T>(aItem);
    if v.IsObject then
      v.AsObject.Free;
  end;
end;

function TLinkedList<T>.GetCurrent: T;
begin
  result := FIndexed.Item;
end;

function TLinkedList<T>.GetEnumerator: TLinkedListEnum;
begin
  result := TLinkedListEnum.Create(self);
end;

function TLinkedList<T>.GetItem(aIndex: integer): T;
var
  i: integer;
  current: TNodeList;

begin
  CheckIndex(aIndex);

  current := FHead;
  for i := 0 to aIndex - 2 do
    current := current.Next;
  Exit(current.Item);
end;

procedure TLinkedList<T>.Insert(aItem, aWhich: T);
var
  NewNode, CurrentNode, prior, next: TNodeList;

begin
  CurrentNode := InternalFind(aWhich);
  if CurrentNode = nil then
    raise Exception.Create('Cannot insert, item does not exists');

  NewNode := TNodeList.Create;
  NewNode.Item := aItem;

  //Update left side
  prior := CurrentNode.Prior;
  if prior <> nil then
  begin
    prior.Next := NewNode;
    NewNode.Prior := prior;
  end else
    NewNode.Prior := nil;

  //Update sides
  NewNode.Next := CurrentNode;
  CurrentNode.Prior := NewNode;

  //Update head?
  if FHead = CurrentNode then
    FHead := NewNode;
end;

function TLinkedList<T>.InternalFind(aItem: T): TNodeList;
var
  current: TNodeList;
  cmp: IComparer<T>;

begin
  result := nil;
  cmp := TComparer<T>.Default;

  if FSearchType = stFromFirst then
    current := FHead
  else
    current := FTail;

  while current <> nil do
  begin
    if cmp.Compare(current.Item, aItem) = 0 then
    begin
      result := current;
      Break;
    end;

    if FSearchType = stFromFirst then
      current := current.Next
    else
      current := current.Prior;
  end;
end;

function TLinkedList<T>.Last: boolean;
begin
  result := FCount > 0;
  if result then
    FIndexed := FTail;
end;

procedure TLinkedList<T>.CheckIndex(aIndex: Integer);
begin
  if aIndex >= FCount then
    raise Exception.Create('Invalid index');
end;

function TLinkedList<T>.Next: boolean;
begin
  result := FIndexed.Next <> nil;
  if result then
    FIndexed := FIndexed.Next;
end;

procedure TLinkedList<T>.SetItem(aIndex: integer; const aItem: T);
var
  i: integer;
  current: TNodeList;

begin
  CheckIndex(aIndex);

  current := FHead;
  for i := 0 to aIndex - 2 do
    current := current.Next;
  current.Item := aItem;
end;

procedure TLinkedList<T>.Sort;
var
  v: TValue;
  list: TList<T>;
  was: boolean;
  i: integer;

begin
  if not First then
    Exit;

  list := TList<T>.Create;
  try
    repeat
      list.Add(GetCurrent);
    until not Next;

    list.Sort(FComparer);

    was := OwnObjects;
    try
      OwnObjects := False;

      Clear;
      for i := 0 to list.Count - 1 do
        Add(list[i]);
    finally
      OwnObjects := was;
    end;

  finally
    list.Free;
  end;
end;

That's it, now I will post the generic queues.