utils/uutlGenerics.pas

unit uutlGenerics;

{ Package:      Utils
  Prefix:       utl - UTiLs
  Beschreibung: diese Unit implementiert allgemein nützliche ausschließlich-generische Klassen }

{$mode objfpc}{$H+}
{$modeswitch nestedprocvars}

interface

uses
  Classes, SysUtils, typinfo, syncobjs;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic IutlEqualityComparer<T> = interface
    function EqualityCompare(const i1, i2: T): Boolean;
  end;

  generic TutlEqualityComparer<T> = class(TInterfacedObject, specialize IutlEqualityComparer<T>)
  public
    function EqualityCompare(const i1, i2: T): Boolean;
  end;

  generic TutlEventEqualityComparer<T> = class(TInterfacedObject, specialize IutlEqualityComparer<T>)
  public type
    TEqualityEvent  = function(const i1, i2: T): Boolean;
    TEqualityEventO = function(const i1, i2: T): Boolean of object;
    TEqualityEventN = function(const i1, i2: T): Boolean is nested;
  private type
    TEqualityEventType = (eetNormal, eetObject, eetNested);
  private
    fEvent: TEqualityEvent;
    fEventO: TEqualityEventO;
    fEventN: TEqualityEventN;
    fEventType: TEqualityEventType;
  public
    function EqualityCompare(const i1, i2: T): Boolean;
    constructor Create(const aEvent: TEqualityEvent); overload;
    constructor Create(const aEvent: TEqualityEventO); overload;
    constructor Create(const aEvent: TEqualityEventN); overload;
    { HINT: you need to activate "$modeswitch nestedprocvars" when you want to use nested callbacks }
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic IutlComparer<T> = interface
    function Compare(const i1, i2: T): Integer;
  end;

  generic TutlComparer<T> = class(TInterfacedObject, specialize IutlComparer<T>)
  public
    function Compare(const i1, i2: T): Integer;
  end;

  generic TutlEventComparer<T> = class(TInterfacedObject, specialize IutlComparer<T>)
  public type
    TEvent  = function(const i1, i2: T): Integer;
    TEventO = function(const i1, i2: T): Integer of object;
    TEventN = function(const i1, i2: T): Integer is nested;
  private type
    TEventType = (etNormal, etObject, etNested);
  private
    fEvent: TEvent;
    fEventO: TEventO;
    fEventN: TEventN;
    fEventType: TEventType;
  public
    function Compare(const i1, i2: T): Integer;
    constructor Create(const aEvent: TEvent); overload;
    constructor Create(const aEvent: TEventO); overload;
    constructor Create(const aEvent: TEventN); overload;
    { HINT: you need to activate "$modeswitch nestedprocvars" when you want to use nested callbacks }
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlListBase<T> = class(TObject)
  private type
    TListItem = packed record
      data: T;
    end;
    PListItem = ^TListItem;

  public type
    TEnumerator = class(TObject)
    private
      fList: TFPList;
      fPosition: Integer;
      function GetCurrent: T;
    public
      property Current: T read GetCurrent;
      function MoveNext: Boolean;
      constructor Create(const aList: TFPList);
    end;

  private
    fList: TFPList;
    fOwnsObjects: Boolean;

  protected
    property List: TFPList read fList;

    function GetCount: Integer;
    function GetItem(const aIndex: Integer): T;
    procedure SetCount(const aValue: Integer);
    procedure SetItem(const aIndex: Integer; const aItem: T);

    function CreateItem: PListItem; virtual;
    procedure DestroyItem(const aItem: PListItem; const aFreeItem: Boolean = true); virtual;
    procedure InsertIntern(const aIndex: Integer; const aItem: T); virtual;
    procedure DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean = true);

  public
    property OwnsObjects: Boolean read fOwnsObjects write fOwnsObjects;

    function GetEnumerator: TEnumerator;
    procedure Clear;

    constructor Create(const aOwnsObjects: Boolean = true);
    destructor Destroy; override;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  { a simple list without the ability to compare objects (e.g. for IndexOf, Remove, Extract) }
  generic TutlSimpleList<T> = class(specialize TutlListBase<T>)
  public type
    IComparer      = specialize IutlComparer<T>;
    TSortDirection = (sdAscending, sdDescending);
  private
    function Split(aComparer: IComparer; const aDirection: TSortDirection; const aLeft, aRight: Integer): Integer;
    procedure QuickSort(aComparer: IComparer; const aDirection: TSortDirection; const aLeft, aRight: Integer);
  public
    property Items[const aIndex: Integer]: T read GetItem write SetItem; default;
    property Count: Integer read GetCount write SetCount;

    function Add(const aItem: T): Integer;
    procedure Insert(const aIndex: Integer; const aItem: T);

    procedure Exchange(const aIndex1, aIndex2: Integer);
    procedure Move(const aCurIndex, aNewIndex: Integer);
    procedure Sort(aComparer: IComparer; const aDirection: TSortDirection = sdAscending);

    procedure Delete(const aIndex: Integer);

    function First: T;
    procedure PushFirst(const aItem: T);
    function PopFirst(const aFreeItem: Boolean = false): T;

    function Last: T;
    procedure PushLast(const aItem: T);
    function PopLast(const aFreeItem: Boolean = false): T;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlCustomList<T> = class(specialize TutlSimpleList<T>)
  public type
    IEqualityComparer = specialize IutlEqualityComparer<T>;
  private
    fEqualityComparer: IEqualityComparer;
  public
    function IndexOf(const aItem: T): Integer;
    function Extract(const aItem: T; const aDefault: T): T;
    function Remove(const aItem: T): Integer;

    constructor Create(aEqualityComparer: IEqualityComparer; const aOwnsObjects: Boolean = true);
    destructor Destroy; override;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlList<T> = class(specialize TutlCustomList<T>)
  public type
    TEqualityComparer = specialize TutlEqualityComparer<T>;
  public
    constructor Create(const aOwnsObjects: Boolean = true);
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlCustomHashSet<T> = class(specialize TutlListBase<T>)
  public type
    IComparer = specialize IutlComparer<T>;
  private
    fComparer: IComparer;
    function SearchItem(const aMin, aMax: Integer; const aItem: T; out aIndex: Integer): Integer;
  public
    property Items[const aIndex: Integer]: T read GetItem; default;
    property Count: Integer read GetCount;

    function Add(const aItem: T): Boolean;
    function Contains(const aItem: T): Boolean;
    function IndexOf(const aItem: T): Integer;
    function Remove(const aItem: T): Boolean;
    procedure Delete(const aIndex: Integer);

    constructor Create(aComparer: IComparer; const aOwnsObjects: Boolean = true);
    destructor Destroy; override;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlHashSet<T> = class(specialize TutlCustomHashSet<T>)
  public type
    TComparer = specialize TutlComparer<T>;
  public
    constructor Create(const aOwnsObjects: Boolean = true);
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  EutlMap = class(Exception);
  generic TutlCustomMap<TKey, TValue> = class(TObject)
  public type
    IComparer = specialize IutlComparer<TKey>;
    TKeyValuePair = packed record
      Key: TKey;
      Value: TValue;
    end;
  private type
    THashSetBase = specialize TutlCustomHashSet<TKeyValuePair>;
    THashSet = class(THashSetBase)
    protected
      procedure DestroyItem(const aItem: PListItem; const aFreeItem: Boolean = true); override;
    public
      property Items[const aIndex: Integer]: TKeyValuePair read GetItem write SetItem; default;
    end;

    TKVPComparer = class(TInterfacedObject, THashSet.IComparer)
    private
      fComparer: IComparer;
    public
      function Compare(const i1, i2: TKeyValuePair): Integer;
      constructor Create(aComparer: IComparer);
      destructor Destroy; override;
    end;

    TValueEnumerator = class(TObject)
    private
      fHashSet: THashSet;
      fPos: Integer;
      function GetCurrent: TValue;
    public
      property Current: TValue read GetCurrent;
      function MoveNext: Boolean;
      constructor Create(const aHashSet: THashSet);
    end;

    TKeyEnumerator = class(TObject)
    private
      fHashSet: THashSet;
      fPos: Integer;
      function GetCurrent: TKey;
    public
      property Current: TKey read GetCurrent;
      function MoveNext: Boolean;
      constructor Create(const aHashSet: THashSet);
    end;

    TKeyValuePairEnumerator = class(TObject)
    private
      fHashSet: THashSet;
      fPos: Integer;
      function GetCurrent: TKeyValuePair;
    public
      property Current: TKeyValuePair read GetCurrent;
      function MoveNext: Boolean;
      constructor Create(const aHashSet: THashSet);
    end;

    TKeyWrapper = class(TObject)
    private
      fHashSet: THashSet;
      function GetItem(const aIndex: Integer): TKey;
      function GetCount: Integer;
    public
      property Items[const aIndex: Integer]: TKey read GetItem; default;
      property Count: Integer read GetCount;
      function GetEnumerator: TKeyEnumerator;
      constructor Create(const aHashSet: THashSet);
    end;

    TKeyValuePairWrapper = class(TObject)
    private
      fHashSet: THashSet;
      function GetItem(const aIndex: Integer): TKeyValuePair;
      function GetCount: Integer;
    public
      property Items[const aIndex: Integer]: TKeyValuePair read GetItem; default;
      property Count: Integer read GetCount;
      function GetEnumerator: TKeyValuePairEnumerator;
      constructor Create(const aHashSet: THashSet);
    end;

  private
    fComparer: IComparer;
    fHashSet: THashSet;
    fKeyWrapper: TKeyWrapper;
    fKeyValuePairWrapper: TKeyValuePairWrapper;

    function GetValues(const aKey:   TKey): TValue;
    function GetValueAt(const aIndex: Integer): TValue;
    function GetCount: Integer;

    procedure SetValueAt(const aIndex: Integer; aValue: TValue);
    procedure SetValues(const aKey:   TKey; aValue: TValue);
  public
    property Values [const aKey:   TKey]:    TValue read GetValues  write SetValues; default;
    property ValueAt[const aIndex: Integer]: TValue read GetValueAt write SetValueAt;
    property Keys:          TKeyWrapper          read fKeyWrapper;
    property KeyValuePairs: TKeyValuePairWrapper read fKeyValuePairWrapper;
    property Count:         Integer              read GetCount;

    procedure Add(const aKey: TKey; const aValue: TValue);
    function IndexOf(const aKey: TKey): Integer;
    function Contains(const aKey: TKey): Boolean;
    procedure Delete(const aKey: TKey);
    procedure DeleteAt(const aIndex: Integer);
    procedure Clear;

    function GetEnumerator: TValueEnumerator;

    constructor Create(aComparer: IComparer; const aOwnsObjects: Boolean = true);
    destructor Destroy; override;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlMap<TKey, TValue> = class(specialize TutlCustomMap<TKey, TValue>)
  public type
    TComparer = specialize TutlComparer<TKey>;
  public
    constructor Create(const aOwnsObjects: Boolean = true);
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
{ Lock-Free Queue for single Producer / Consumer calls;
  Producer and Consumer are synchronized with SpinLocks }
  generic TutlQueue<T> = class(TObject)
  public type
    PListItem = ^TListItem;
    TListItem = packed record
      data: T;
      next: PListItem;
    end;
  private
    function GetCount: Integer;
  protected
    fFirst: PListItem;
    fLast: PListItem;
    fFirstLock: Cardinal;
    fLastLock: Cardinal;
    fCount: Integer;
    fOwnsObjects: Boolean;
  public
    property Count: Integer read GetCount;

    procedure Push(const aItem: T); virtual;
    function Pop(out aItem: T): Boolean; virtual;
    function Pop: Boolean;
    procedure Clear;

    constructor Create(const aOwnsObjects: Boolean = true);
    destructor Destroy; override;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlInterfaceList<T> = class(TInterfaceList)
  private type
    TInterfaceEnumerator = class(TObject)
    private
      fList: TInterfaceList;
      fPos: Integer;
      function GetCurrent: T;
    public
      property Current: T read GetCurrent;
      function MoveNext: Boolean;
      constructor Create(const aList: TInterfaceList);
    end;

  private
    function Get(i : Integer): T;
    procedure Put(i : Integer; aItem : T);
  public
    property Items[Index : Integer]: T read Get write Put; default;

    function First: T;
    function IndexOf(aItem : T): Integer;
    function Add(aItem : IUnknown): Integer;
    procedure Insert(i : Integer; aItem : T);
    function Last : T;
    function Remove(aItem : T): Integer;

    function GetEnumerator: TInterfaceEnumerator;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlEnumHelper<T> = class(TObject)
  private type
    TValueArray = array of T;
  public
    class function ToString(aValue: T): String; reintroduce;
    class function TryToEnum(aStr: String; out aValue: T): Boolean;
    class function ToEnum(aStr: String): T; overload;
    class function ToEnum(aStr: String; const aDefault: T): T; overload;
    class function Values: TValueArray;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlRingBuffer<T> = class
  private
    fAborted: boolean;
    fData: packed array of T;
    fDataLen: Integer;
    fDataSize: integer;
    fFillState: integer;
    fWritePtr, fReadPtr: integer;
    fWrittenEvent,
    fReadEvent: TEvent;
  public
    constructor Create(const Elements: Integer);
    destructor Destroy; override;
    function Read(Buf: Pointer; Items: integer; BlockUntilAvail: boolean): integer;
    function Write(Buf: Pointer; Items: integer; BlockUntilDone: boolean): integer;
    procedure BreakPipe;
    property  FillState: Integer read fFillState;
    property Size: integer read fDataLen;
  end;

  function utlFreeOrFinalize(var obj; const aTypeInfo: PTypeInfo; const aFreeObj: Boolean = true): Boolean;

implementation

uses
  uutlExceptions, uutlThreads;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//Helper////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
operator < (const i1, i2: TObject): Boolean; inline;
begin
  result := PtrUInt(i1) < PtrUInt(i2);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
operator > (const i1, i2: TObject): Boolean; inline;
begin
  result := PtrUInt(i1) > PtrUInt(i2);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function utlFreeOrFinalize(var obj; const aTypeInfo: PTypeInfo; const aFreeObj: Boolean = true): Boolean;
var
  o: TObject;
begin
  result := true;
  case aTypeInfo^.Kind of
    tkClass: begin
      if (aFreeObj) then begin
        o := TObject(obj);
        Pointer(obj) := nil;
        o.Free;
      end;
    end;

    tkInterface: begin
      IUnknown(obj) := nil;
    end;

    tkAString: begin
      AnsiString(Obj) := '';
    end;

    tkUString: begin
      UnicodeString(Obj) := '';
    end;

    tkString: begin
      String(Obj) := '';
    end;
  else
    result := false;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlEqualityComparer//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlEqualityComparer.EqualityCompare(const i1, i2: T): Boolean;
begin
  result := (i1 = i2);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlEventEqualityComparer.EqualityCompare(const i1, i2: T): Boolean;
begin
  case fEventType of
    eetNormal: result := fEvent(i1, i2);
    eetObject: result := fEventO(i1, i2);
    eetNested: result := fEventN(i1, i2);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlEventEqualityComparer.Create(const aEvent: TEqualityEvent);
begin
  inherited Create;
  fEvent     := aEvent;
  fEventType := eetNormal;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlEventEqualityComparer.Create(const aEvent: TEqualityEventO);
begin
  inherited Create;
  fEventO    := aEvent;
  fEventType := eetObject;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlEventEqualityComparer.Create(const aEvent: TEqualityEventN);
begin
  inherited Create;
  fEventN    := aEvent;
  fEventType := eetNested;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlComparer//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlComparer.Compare(const i1, i2: T): Integer;
begin
  if (i1 < i2) then
    result := -1
  else if (i1 > i2) then
    result := 1
  else
    result := 0;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlEventComparer.Compare(const i1, i2: T): Integer;
begin
  case fEventType of
    etNormal: result := fEvent(i1, i2);
    etObject: result := fEventO(i1, i2);
    etNested: result := fEventN(i1, i2);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlEventComparer.Create(const aEvent: TEvent);
begin
  inherited Create;
  fEvent     := aEvent;
  fEventType := etNormal;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlEventComparer.Create(const aEvent: TEventO);
begin
  inherited Create;
  fEventO    := aEvent;
  fEventType := etObject;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlEventComparer.Create(const aEvent: TEventN);
begin
  inherited Create;
  fEventN    := aEvent;
  fEventType := etNested;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlListBase//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlListBase.TEnumerator.GetCurrent: T;
begin
  result := PListItem(fList[fPosition])^.data;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlListBase.TEnumerator.MoveNext: Boolean;
begin
  inc(fPosition);
  result := (fPosition < fList.Count)
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlListBase.TEnumerator.Create(const aList: TFPList);
begin
  inherited Create;
  fList     := aList;
  fPosition := -1;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlListBase//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlListBase.GetCount: Integer;
begin
  result := fList.Count;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlListBase.GetItem(const aIndex: Integer): T;
begin
  if (aIndex >= 0) and (aIndex < fList.Count) then
    result := PListItem(fList[aIndex])^.data
  else
    raise EOutOfRange.Create(aIndex, 0, fList.Count-1);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListBase.SetCount(const aValue: Integer);
var
  item: PListItem;
begin
  if (aValue < 0) then
    raise EArgument.Create('new value for count must be positiv');
  while (aValue > fList.Count) do begin
    item := CreateItem;
    FillByte(item^, SizeOf(item^), 0);
    fList.Add(item);
  end;
  while (aValue < fList.Count) do
    DeleteIntern(fList.Count-1);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListBase.SetItem(const aIndex: Integer; const aItem: T);
var
  item: PListItem;
begin
  if (aIndex >= 0) and (aIndex < fList.Count) then begin
    item := PListItem(fList[aIndex]);
    utlFreeOrFinalize(item^, TypeInfo(item^), fOwnsObjects);
    item^.data := aItem;
  end else
    raise EOutOfRange.Create(aIndex, 0, fList.Count-1);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlListBase.CreateItem: PListItem;
begin
  new(result);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListBase.DestroyItem(const aItem: PListItem; const aFreeItem: Boolean);
begin
  utlFreeOrFinalize(aItem^.data, TypeInfo(aItem^.data), fOwnsObjects and aFreeItem);
  Dispose(aItem);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListBase.InsertIntern(const aIndex: Integer; const aItem: T);
var
  item: PListItem;
begin
  item := CreateItem;
  try
    item^.data := aItem;
    fList.Insert(aIndex, item);
  except
    DestroyItem(item, false);
    raise;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListBase.DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean);
var
  item: PListItem;
begin
  if (aIndex >= 0) and (aIndex < fList.Count) then begin
    item := PListItem(fList[aIndex]);
    fList.Delete(aIndex);
    DestroyItem(item, aFreeItem);
  end else
    raise EOutOfRange.Create(aIndex, 0, fList.Count-1);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlListBase.GetEnumerator: TEnumerator;
begin
  result := TEnumerator.Create(fList);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListBase.Clear;
begin
  while (fList.Count > 0) do
    DeleteIntern(fList.Count-1);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlListBase.Create(const aOwnsObjects: Boolean);
begin
  inherited Create;
  fOwnsObjects := aOwnsObjects;
  fList        := TFPList.Create;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlListBase.Destroy;
begin
  Clear;
  FreeAndNil(fList);
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlSimpleList////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlSimpleList.Split(aComparer: IComparer; const aDirection: TSortDirection; const aLeft, aRight: Integer): Integer;
var
  i, j: Integer;
  pivot: T;
begin
  i := aLeft;
  j := aRight - 1;
  pivot := GetItem(aRight);
  repeat
    while ((aDirection = sdAscending)  and (aComparer.Compare(GetItem(i), pivot) <= 0) or
           (aDirection = sdDescending) and (aComparer.Compare(GetItem(i), pivot) >= 0)) and
          (i < aRight) do inc(i);

    while ((aDirection = sdAscending)  and (aComparer.Compare(GetItem(j), pivot) >= 0) or
           (aDirection = sdDescending) and (aComparer.Compare(GetItem(j), pivot) <= 0)) and
          (j > aLeft) do dec(j);

    if (i < j) then
      Exchange(i, j);
  until (i >= j);

  if ((aDirection = sdAscending)  and (aComparer.Compare(GetItem(i), pivot) > 0)) or
     ((aDirection = sdDescending) and (aComparer.Compare(GetItem(i), pivot) < 0)) then
          Exchange(i, aRight);

  result := i;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlSimpleList.QuickSort(aComparer: IComparer; const aDirection: TSortDirection; const aLeft, aRight: Integer);
var
  s: Integer;
begin
  if (aLeft < aRight) then begin
    s := Split(aComparer, aDirection, aLeft, aRight);
    QuickSort(aComparer, aDirection, aLeft, s - 1);
    QuickSort(aComparer, aDirection, s + 1, aRight);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlSimpleList.Add(const aItem: T): Integer;
begin
  result := Count;
  InsertIntern(result, aItem);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlSimpleList.Insert(const aIndex: Integer; const aItem: T);
begin
  InsertIntern(aIndex, aItem);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlSimpleList.Exchange(const aIndex1, aIndex2: Integer);
begin
  if (aIndex1 < 0) or (aIndex1 >= Count) then
    raise EOutOfRange.Create(aIndex1, 0, Count-1);
  if (aIndex2 < 0) or (aIndex2 >= Count) then
    raise EOutOfRange.Create(aIndex2, 0, Count-1);
  fList.Exchange(aIndex1, aIndex2);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlSimpleList.Move(const aCurIndex, aNewIndex: Integer);
begin
  if (aCurIndex < 0) or (aCurIndex >= Count) then
    raise EOutOfRange.Create(aCurIndex, 0, Count-1);
  if (aNewIndex < 0) or (aNewIndex >= Count) then
    raise EOutOfRange.Create(aNewIndex, 0, Count-1);
  fList.Move(aCurIndex, aNewIndex);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlSimpleList.Sort(aComparer: IComparer; const aDirection: TSortDirection);
begin
  QuickSort(aComparer, aDirection, 0, fList.Count-1);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlSimpleList.Delete(const aIndex: Integer);
begin
  DeleteIntern(aIndex);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlSimpleList.First: T;
begin
  result := Items[0];
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlSimpleList.PushFirst(const aItem: T);
begin
  InsertIntern(0, aItem);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlSimpleList.PopFirst(const aFreeItem: Boolean): T;
begin
  if aFreeItem then
    FillByte(result{%H-}, SizeOf(result), 0)
  else
    result := First;
  DeleteIntern(0, aFreeItem);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlSimpleList.Last: T;
begin
  result := Items[Count-1];
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlSimpleList.PushLast(const aItem: T);
begin
  InsertIntern(Count, aItem);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlSimpleList.PopLast(const aFreeItem: Boolean): T;
begin
  if aFreeItem then
    FillByte(result{%H-}, SizeOf(result), 0)
  else
    result := Last;
  DeleteIntern(Count-1, aFreeItem);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlCustomList////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomList.IndexOf(const aItem: T): Integer;
var
  c: Integer;
begin
  c := List.Count;
  result := 0;
  while (result < c) and
        not fEqualityComparer.EqualityCompare(PListItem(List[result])^.data, aItem) do
    inc(result);
  if (result >= c) then
    result := -1;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomList.Extract(const aItem: T; const aDefault: T): T;
var
  i: Integer;
begin
  i := IndexOf(aItem);
  if (i >= 0) then begin
    result := Items[i];
    DeleteIntern(i, false);
  end else
    result := aDefault;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomList.Remove(const aItem: T): Integer;
begin
  result := IndexOf(aItem);
  if (result >= 0) then
    DeleteIntern(result);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlCustomList.Create(aEqualityComparer: IEqualityComparer; const aOwnsObjects: Boolean);
begin
  inherited Create(aOwnsObjects);
  fEqualityComparer := aEqualityComparer;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlCustomList.Destroy;
begin
  fEqualityComparer := nil;
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlList//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlList.Create(const aOwnsObjects: Boolean);
begin
  inherited Create(TEqualityComparer.Create, aOwnsObjects);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlCustomHashSet/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomHashSet.SearchItem(const aMin, aMax: Integer; const aItem: T; out aIndex: Integer): Integer;
var
  i, cmp: Integer;
begin
  if (aMin <= aMax) then begin
    i   := aMin + Trunc((aMax - aMin) / 2);
    cmp := fComparer.Compare(aItem, GetItem(i));
    if (cmp = 0) then
      result := i
    else if (cmp < 0) then
      result := SearchItem(aMin, i-1, aItem, aIndex)
    else if (cmp > 0) then
      result := SearchItem(i+1, aMax, aItem, aIndex);
  end else begin
    result := -1;
    aIndex := aMin;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomHashSet.Add(const aItem: T): Boolean;
var
  i: Integer;
begin
  result := (SearchItem(0, List.Count-1, aItem, i) < 0);
  if result then
    InsertIntern(i, aItem);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomHashSet.Contains(const aItem: T): Boolean;
var
  tmp: Integer;
begin
  result := (SearchItem(0, List.Count-1, aItem, tmp) >= 0);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomHashSet.IndexOf(const aItem: T): Integer;
var
  tmp: Integer;
begin
  result := SearchItem(0, List.Count-1, aItem, tmp);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomHashSet.Remove(const aItem: T): Boolean;
var
  i, tmp: Integer;
begin
  i := SearchItem(0, List.Count-1, aItem, tmp);
  result := (i >= 0);
  if result then
    DeleteIntern(i);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCustomHashSet.Delete(const aIndex: Integer);
begin
  DeleteIntern(aIndex);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlCustomHashSet.Create(aComparer: IComparer; const aOwnsObjects: Boolean);
begin
  inherited Create(aOwnsObjects);
  fComparer := aComparer;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlCustomHashSet.Destroy;
begin
  fComparer := nil;
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlHashSet///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlHashSet.Create(const aOwnsObjects: Boolean);
begin
  inherited Create(TComparer.Create, aOwnsObjects);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlCustomMap.THashSet////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCustomMap.THashSet.DestroyItem(const aItem: PListItem; const aFreeItem: Boolean);
begin
  utlFreeOrFinalize(aItem^.data.key,   TypeInfo(aItem^.data.key),   aFreeItem and OwnsObjects);
  utlFreeOrFinalize(aItem^.data.value, TypeInfo(aItem^.data.value), aFreeItem and OwnsObjects);
  inherited DestroyItem(aItem, aFreeItem);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlCustomMap.TKVPComparer////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.TKVPComparer.Compare(const i1, i2: TKeyValuePair): Integer;
begin
  result := fComparer.Compare(i1.Key, i2.Key);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlCustomMap.TKVPComparer.Create(aComparer: IComparer);
begin
  inherited Create;
  fComparer := aComparer;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlCustomMap.TKVPComparer.Destroy;
begin
  fComparer := nil;
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlCustomMap.TValueEnumerator////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.TValueEnumerator.GetCurrent: TValue;
begin
  result := fHashSet[fPos].Value;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.TValueEnumerator.MoveNext: Boolean;
begin
  inc(fPos);
  result := (fPos < fHashSet.Count);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlCustomMap.TValueEnumerator.Create(const aHashSet: THashSet);
begin
  inherited Create;
  fHashSet := aHashSet;
  fPos     := -1;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlCustomMap.TKeyEnumerator//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.TKeyEnumerator.GetCurrent: TKey;
begin
  result := fHashSet[fPos].Key;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.TKeyEnumerator.MoveNext: Boolean;
begin
  inc(fPos);
  result := (fPos < fHashSet.Count);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlCustomMap.TKeyEnumerator.Create(const aHashSet: THashSet);
begin
  inherited Create;
  fHashSet := aHashSet;
  fPos     := -1;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlCustomMap.TKeyValuePairEnumerator/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.TKeyValuePairEnumerator.GetCurrent: TKeyValuePair;
begin
  result := fHashSet[fPos];
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.TKeyValuePairEnumerator.MoveNext: Boolean;
begin
  inc(fPos);
  result := (fPos < fHashSet.Count);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlCustomMap.TKeyValuePairEnumerator.Create(const aHashSet: THashSet);
begin
  inherited Create;
  fHashSet := aHashSet;
  fPos     := -1;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlCustomMap.TKeyWrapper/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.TKeyWrapper.GetItem(const aIndex: Integer): TKey;
begin
  result := fHashSet[aIndex].Key;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.TKeyWrapper.GetCount: Integer;
begin
  result := fHashSet.Count;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.TKeyWrapper.GetEnumerator: TKeyEnumerator;
begin
  result := TKeyEnumerator.Create(fHashSet);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlCustomMap.TKeyWrapper.Create(const aHashSet: THashSet);
begin
  inherited Create;
  fHashSet := aHashSet;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlCustomMap.TKeyValuePairWrapper////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.TKeyValuePairWrapper.GetItem(const aIndex: Integer): TKeyValuePair;
begin
  result := fHashSet[aIndex];
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.TKeyValuePairWrapper.GetCount: Integer;
begin
  result := fHashSet.Count;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.TKeyValuePairWrapper.GetEnumerator: TKeyValuePairEnumerator;
begin
  result := TKeyValuePairEnumerator.Create(fHashSet);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlCustomMap.TKeyValuePairWrapper.Create(const aHashSet: THashSet);
begin
  inherited Create;
  fHashSet := aHashSet;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlCustomMap/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.GetValues(const aKey: TKey): TValue;
var
  i: Integer;
  kvp: TKeyValuePair;
begin
  kvp.Key := aKey;
  i := fHashSet.IndexOf(kvp);
  if (i < 0) then
    FillByte(result{%H-}, SizeOf(result), 0)
  else
    result := fHashSet[i].Value;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.GetValueAt(const aIndex: Integer): TValue;
begin
  result := fHashSet[aIndex].Value;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.GetCount: Integer;
begin
  result := fHashSet.Count;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCustomMap.SetValues(const aKey: TKey; aValue: TValue);
var
  i: Integer;
  kvp: TKeyValuePair;
begin
  kvp.Key   := aKey;
  kvp.Value := aValue;
  i := fHashSet.IndexOf(kvp);
  if (i < 0) then
    raise EutlMap.Create('key not found');
  fHashSet[i] := kvp;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCustomMap.SetValueAt(const aIndex: Integer; aValue: TValue);
var
  kvp: TKeyValuePair;
begin
  kvp := fHashSet[aIndex];
  kvp.Value := aValue;
  fHashSet[aIndex] := kvp;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCustomMap.Add(const aKey: TKey; const aValue: TValue);
var
  kvp: TKeyValuePair;
begin
  kvp.Key   := aKey;
  kvp.Value := aValue;
  if not fHashSet.Add(kvp) then
    raise EutlMap.Create('key is already in list');
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.IndexOf(const aKey: TKey): Integer;
var
  kvp: TKeyValuePair;
begin
  kvp.Key := aKey;
  result := fHashSet.IndexOf(kvp);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.Contains(const aKey: TKey): Boolean;
var
  kvp: TKeyValuePair;
begin
  kvp.Key := aKey;
  result := (fHashSet.IndexOf(kvp) >= 0);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCustomMap.Delete(const aKey: TKey);
var
  kvp: TKeyValuePair;
begin
  kvp.Key := aKey;
  if not fHashSet.Remove(kvp) then
    raise EutlMap.Create('key not found');
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCustomMap.DeleteAt(const aIndex: Integer);
begin
  fHashSet.Delete(aIndex);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCustomMap.Clear;
begin
  fHashSet.Clear;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.GetEnumerator: TValueEnumerator;
begin
  result := TValueEnumerator.Create(fHashSet);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlCustomMap.Create(aComparer: IComparer; const aOwnsObjects: Boolean);
begin
  inherited Create;
  fComparer            := aComparer;
  fHashSet             := THashSet.Create(TKVPComparer.Create(fComparer), aOwnsObjects);
  fKeyWrapper          := TKeyWrapper.Create(fHashSet);
  fKeyValuePairWrapper := TKeyValuePairWrapper.Create(fHashSet);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlCustomMap.Destroy;
begin
  FreeAndNil(fKeyValuePairWrapper);
  FreeAndNil(fKeyWrapper);
  FreeAndNil(fHashSet);
  fComparer := nil;
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlMap.Create(const aOwnsObjects: Boolean);
begin
  inherited Create(TComparer.Create, aOwnsObjects);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlQueue/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlQueue.GetCount: Integer;
begin
  InterLockedExchange(result{%H-}, fCount);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlQueue.Push(const aItem: T);
var
  p: PListItem;
begin
  // do as much as possible outside of the lock
  new(p);
  p^.data := aItem;
  p^.next := nil;

  while (InterLockedExchange(fLastLock, 1) <> 0) do;
  try
    fLast^.next := p;       // is protected by fCount (if fCount = 0 then fLast = fFirst,
    fLast := fLast^.next;   // so pop must always check fCount, before touching fFirst)
    InterLockedIncrement(fCount);
  finally
    InterLockedExchange(fLastLock, 0);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlQueue.Pop(out aItem: T): Boolean;
var
  old: PListItem;
begin
  // do as much as possible outside of the lock
  result := false;
  FillByte(aItem{%H-}, SizeOf(aItem), 0);

  while (InterLockedExchange(fFirstLock, 1) <> 0) do;
  try
    if (Count <= 0) then
      exit;
    result := true;
    old    := fFirst;
    fFirst := fFirst^.next;
    aItem  := fFirst^.data;
    InterLockedDecrement(fCount);
  finally
    InterLockedExchange(fFirstLock, 0);
  end;
  Dispose(old);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlQueue.Pop: Boolean;
var
  tmp: T;
begin
  result := Pop(tmp);
  utlFreeOrFinalize(tmp, TypeInfo(tmp), fOwnsObjects);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlQueue.Clear;
begin
  while Pop do;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlQueue.Create(const aOwnsObjects: Boolean);
begin
  inherited Create;
  new(fFirst);
  FillByte(fFirst^, SizeOf(fFirst^), 0);
  fLast        := fFirst;
  fFirstLock   := 0;
  fLastLock    := 0;
  fCount       := 0;
  fOwnsObjects := aOwnsObjects;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlQueue.Destroy;
begin
  Clear;
  if Assigned(fLast) then begin
    Dispose(fLast);
    fLast := nil;
  end;
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlInterfaceList.TInterfaceEnumerator////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlInterfaceList.TInterfaceEnumerator.GetCurrent: T;
begin
  result := T(fList[fPos]);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlInterfaceList.TInterfaceEnumerator.MoveNext: Boolean;
begin
  inc(fPos);
  result := (fPos < fList.Count);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlInterfaceList.TInterfaceEnumerator.Create(const aList: TInterfaceList);
begin
  inherited Create;
  fPos  := -1;
  fList := aList;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlInterfaceList/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlInterfaceList.Get(i : Integer): T;
begin
  result := T(inherited Get(i));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlInterfaceList.Put(i : Integer; aItem : T);
begin
  inherited Put(i, aItem);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlInterfaceList.First: T;
begin
  result := T(inherited First);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlInterfaceList.IndexOf(aItem : T): Integer;
begin
  result := inherited IndexOf(aItem);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlInterfaceList.Add(aItem : IUnknown): Integer;
begin
  result := inherited Add(aItem);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlInterfaceList.Insert(i : Integer; aItem : T);
begin
  inherited Insert(i, aItem);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlInterfaceList.Last : T;
begin
  result := T(inherited Last);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlInterfaceList.Remove(aItem : T): Integer;
begin
  result := inherited Remove(aItem);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlInterfaceList.GetEnumerator: TInterfaceEnumerator;
begin
  result := TInterfaceEnumerator.Create(self);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlEnumHelper////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelper.ToString(aValue: T): String;
Var
  PS: PShortString;
  TI: PTypeInfo;
  PT: PTypeData;
  num: Integer;
begin
  TI := TypeInfo(T);
  PT := GetTypeData(TI);
  if TI^.Kind = tkBool then begin
    case Integer(aValue) of
      0,1:
        Result:=BooleanIdents[Boolean(aValue)];
      else
        Result:='';
    end;
  end else begin
    num := Integer(aValue);
    if (num >= PT^.MinValue) and (num <= PT^.MaxValue) then begin
      PS := @PT^.NameList;
      dec(num, PT^.MinValue);
      while num > 0 do begin
        PS := PShortString(pointer(PS) + PByte(PS)^ + 1);
        Dec(Num);
      end;
      Result := PS^;
    end else
      Result := '';
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelper.TryToEnum(aStr: String; out aValue: T): Boolean;
Var
  PS: PShortString;
  PT: PTypeData;
  Count: longint;
  sName: shortstring;
  TI: PTypeInfo;
begin
  TI     := TypeInfo(T);
  PT     := GetTypeData(TI);
  Result := False;
  if Length(aStr) = 0 then
    exit;
  sName := aStr;

  if TI^.Kind = tkBool then begin
    If CompareText(BooleanIdents[false], aStr) = 0 then
      aValue := T(0)
    else if CompareText(BooleanIdents[true], aStr) = 0 then
      aValue := T(1);
    Result := true;
  end else begin
    PS    := @PT^.NameList;
    Count := 0;
    While (PByte(PS)^ <> 0) do begin
      If ShortCompareText(PS^, sName) = 0 then begin
        aValue := T(Count + PT^.MinValue);
        exit(true);
      end;
      PS := PShortString(pointer(PS) + PByte(PS)^ + 1);
      Inc(Count);
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelper.ToEnum(aStr: String): T;
begin
  if not TryToEnum(aStr, result) then
    raise EConvertError.CreateFmt('"%s" is an invalid %s',[aStr, PTypeInfo(TypeInfo(T))^.Name]);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelper.ToEnum(aStr: String; const aDefault: T): T;
begin
  if not TryToEnum(aStr, result) then
    result := aDefault;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelper.Values: TValueArray;
Var
  TI: PTypeInfo;
  PT: PTypeData;
  i,j: integer;
begin
  TI := TypeInfo(T);
  PT := GetTypeData(TI);
  if TI^.Kind = tkBool then begin
    SetLength(Result, 2);
    Result[0]:= T(true);
    Result[1]:= T(false);
  end else begin
    SetLength(Result, PT^.MaxValue - PT^.MinValue + 1);
    j:= 0;
    for i:= PT^.MinValue to PT^.MaxValue do begin
      Result[j]:= T(i);
      inc(j);
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlRingBuffer////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlRingBuffer.Create(const Elements: Integer);
begin
  inherited Create;
  fAborted:= false;
  fDataLen:= Elements;
  fDataSize:= SizeOf(T);
  SetLength(fData, fDataLen);
  fWritePtr:= 1;
  fReadPtr:= 0;
  fFillState:= 0;
  fReadEvent:= TAutoResetEvent.Create;
  fWrittenEvent:= TAutoResetEvent.Create;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlRingBuffer.Destroy;
begin
  BreakPipe;
  FreeAndNil(fReadEvent);
  FreeAndNil(fWrittenEvent);
  SetLength(fData, 0);
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlRingBuffer.Read(Buf: Pointer; Items: integer; BlockUntilAvail: boolean): integer;
var
  wp, c, r: Integer;
begin
  Result:= 0;
  while Items > 0 do begin
    if fAborted then
      exit;

    InterLockedExchange(wp{%H-}, fWritePtr);
    r:= (fReadPtr + 1) mod fDataLen;
    if wp < r then
      wp:= fDataLen;
    c:= wp - r;
    if c > Items then
      c:= Items;
    if c > 0 then begin
      Move(fData[r], Buf^, c * fDataSize);
      Dec(Items, c);
      inc(Result, c);
      dec(fFillState, c);
      inc(PByte(Buf), c * fDataSize);
      InterLockedExchange(fReadPtr, (fReadPtr + c) mod fDataLen);
      fReadEvent.SetEvent;
    end else begin
      if not BlockUntilAvail then
        break;
      fWrittenEvent.WaitFor(INFINITE);
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlRingBuffer.Write(Buf: Pointer; Items: integer; BlockUntilDone: boolean): integer;
var
  rp, c: integer;
begin
  Result:= 0;
  while Items > 0 do begin
    if fAborted then
      exit;

    InterLockedExchange(rp{%H-}, fReadPtr);
    if rp < fWritePtr then
      rp:= fDataLen;
    c:= rp - fWritePtr;
    if c > Items then
      c:= Items;
    if c > 0 then begin
      Move(Buf^, fData[fWritePtr], c * fDataSize);
      dec(Items, c);
      inc(Result, c);
      inc(fFillState, c);
      inc(PByte(Buf), c * fDataSize);
      InterLockedExchange(fWritePtr, (fWritePtr + c) mod fDataLen);
      fWrittenEvent.SetEvent;
    end else begin
      if not BlockUntilDone then
        Break;
      fReadEvent.WaitFor(INFINITE);
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlRingBuffer.BreakPipe;
begin
  fAborted:= true;
  fWrittenEvent.SetEvent;
  fReadEvent.SetEvent;
end;


end.