procedure Test;
var
  arr: TList<Integer>;
  i: Integer;
begin
  arr := TList<Integer>.Create;
  with arr do
  begin
    for i := 0 to 50000000 do
      add(i);
  end;
end;

procedure Test; 
var
  arr: TArrayEx<Integer>;
  i: Integer;
begin
  with arr do
  begin

    init;

    for i := 0 to 50000000 do
      add(i);
  end;
end;

// VER: 0.0.1
// Author: Гирлионайльдо

unit FastListArray;

interface

uses
  System.SysUtils, System.Generics.Defaults;

type
  PDynArrayRec = ^TDynArrayRec;

  TDynArrayRec = packed record
{$IFDEF CPU64BITS}
    _Padding: Integer; // Make 16 byte align for payload..
{$ENDIF}
    RefCnt: Integer;
    Length: NativeInt;
  end;

  TArrayExSortCompare<T> = function(Item1, Item2: T): Integer;
  TArrayExSortCompareFunc<T> = reference to function(Item1, Item2: T): Integer;

  TArrayEx<T> = record
  public
    Items: TArray<T>;
    CurrentLength, MaxLength: NativeUInt;
    Comparer: IComparer<T>;
  public
    procedure init;
    procedure free;
    procedure add(Value: T);
    function IndexOf(Item: T): NativeUInt;
    function Delete(i: NativeUInt): T;
    function Remove(Item: T): NativeUInt;
    procedure Move(CurIndex, NewIndex: NativeUInt);
    procedure Insert(Index: NativeUInt; Item: T);
    procedure Sort(Compare: TArrayExSortCompare<T>);
    procedure SortList(const Compare: TArrayExSortCompareFunc<T>);
    function First: T;
    function Last: T;
  private
    procedure QuickSort(var SortList: TArray<T>; L, R: NativeUInt;
      SCompare: TArrayExSortCompareFunc<T>);

  type
    Test = TArray<T>;

  const
    elSize = SizeOf(Pointer);
    Plus = 48;
  end;

implementation

procedure TArrayEx<T>.init;
begin
  if NativeUInt(Items) <> 0 then
    free;

  Comparer := TComparer<T>.Default;
  CurrentLength := 0;
  MaxLength := Plus;
  PPointer(@Items)^ := SysGetMem(MaxLength * elSize + SizeOf(TDynArrayRec));
  Inc(PByte(Items), SizeOf(TDynArrayRec));
end;

procedure TArrayEx<T>.free;
begin
  Dec(PByte(Items), SizeOf(TDynArrayRec));
  SysFreeMem(PPointer(@Items)^);
  CurrentLength := 0;
  MaxLength := 0;
  PPointer(@Items)^ := nil;
end;

procedure TArrayEx<T>.add(Value: T);
begin
  if MaxLength < CurrentLength then
  begin
    Inc(MaxLength, Plus);
    Dec(PByte(Items), SizeOf(TDynArrayRec));
    PPointer(@Items)^ := SysReallocMem(PPointer(@Items)^,
      MaxLength * elSize + SizeOf(TDynArrayRec));
    Inc(PByte(Items), SizeOf(TDynArrayRec));
  end;

  Test(Items)[CurrentLength] := Value;

  Inc(CurrentLength);

  PNativeInt(PByte(Items) - SizeOf(NativeInt))^ := CurrentLength;
end;

function TArrayEx<T>.IndexOf(Item: T): NativeUInt;
var
  i: NativeUInt;
begin
  i := CurrentLength;
  while i <> NativeUInt.MaxValue do
  begin
    if Comparer.Compare(Items[i], Item) = 0 then
      exit(i);
    Dec(i);
  end;
  Result := NativeUInt.MaxValue;
end;

function TArrayEx<T>.Delete(i: NativeUInt): T;
begin
  if i <= MaxLength then
  begin
    Dec(MaxLength);
    System.Move(Test(Items)[i + 1], Test(Items)[i],
      (MaxLength - i) * SizeOf(elSize));

    Dec(CurrentLength);

    PNativeInt(PByte(Items) - SizeOf(NativeInt))^ := CurrentLength;
  end;
end;

function TArrayEx<T>.Remove(Item: T): NativeUInt;
var
  i: NativeUInt;
begin
  i := CurrentLength;
  while i <> NativeUInt.MaxValue do
  begin
    if Comparer.Compare(Items[i], Item) = 0 then
    begin
      Delete(i);
      exit(i);
    end;
    Dec(i);
  end;
  Result := NativeUInt.MaxValue;
end;

procedure TArrayEx<T>.Move(CurIndex, NewIndex: NativeUInt);
var
  cT: T;
begin
  if (CurIndex <= CurrentLength) and (NewIndex <= CurrentLength) then
  begin
    cT := Items[CurIndex];
    Items[CurIndex] := Items[NewIndex];
    Items[NewIndex] := cT;
  end;
end;

procedure TArrayEx<T>.Insert(Index: NativeUInt; Item: T);
var
  cT: NativeUInt;
begin
  if Index <= CurrentLength then
  begin
    cT := IndexOf(Item);
    if cT <> NativeUInt.MaxValue then
    begin
      Items[cT] := Items[Index];
      Items[Index] := Item;
    end;
  end;
end;

procedure TArrayEx<T>.QuickSort(var SortList: TArray<T>; L, R: NativeUInt;
  SCompare: TArrayExSortCompareFunc<T>);
var
  i, J: NativeUInt;
  P, c: T;
begin
  if L < R then
  begin
    repeat
      if (R - L) = 1 then
      begin
        if SCompare(SortList[L], SortList[R]) > 0 then
        begin
          c := SortList[L];
          SortList[L] := SortList[R];
          SortList[R] := c;
        end;
        break;
      end;
      i := L;
      J := R;
      P := SortList[(L + R) shr 1];
      repeat
        while SCompare(SortList[i], P) < 0 do
          Inc(i);
        while SCompare(SortList[J], P) > 0 do
          Dec(J);
        if i <= J then
        begin
          if i <> J then
          begin
            c := SortList[i];
            SortList[i] := SortList[J];
            SortList[J] := c;
          end;
          Inc(i);
          Dec(J);
        end;
      until i > J;
      if (J - L) > (R - i) then
      begin
        if i < R then
          QuickSort(SortList, i, R, SCompare);
        R := J;
      end
      else
      begin
        if L < J then
          QuickSort(SortList, L, J, SCompare);
        L := i;
      end;
    until L >= R;
  end;
end;

procedure TArrayEx<T>.Sort(Compare: TArrayExSortCompare<T>);
begin
  QuickSort(Items, 0, CurrentLength - 1,
    function(Item1, Item2: T): Integer
    begin
      Result := Compare(Item1, Item2);
    end);
end;

procedure TArrayEx<T>.SortList(const Compare: TArrayExSortCompareFunc<T>);
begin
  QuickSort(Items, 0, CurrentLength - 1, Compare);
end;

function TArrayEx<T>.First: T;
begin
  Result := Items[0];
end;

function TArrayEx<T>.Last: T;
begin
  Result := Items[CurrentLength];
end;

end.

program Project1;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  windows, System.SysUtils, FastListArray, System.Generics.Collections;

function sprintf(S: PAnsiChar; const Format: PAnsiChar): Integer; cdecl;
  varargs; external 'msvcrt.dll';

function PrintTime(T: Int64): AnsiString;
var
  A, b: Int64;
begin
  Result := '';
  if QueryPerformanceCounter(A) and QueryPerformanceFrequency(b) then
  begin
    SetLength(Result, 25);
    SetLength(Result, sprintf(PAnsiChar(Result), '%f', single((A - T) / b)));
  end;
end;

procedure Test2;
var
  arr: TList<Integer>;
  i: Integer;
begin
  arr := TList<Integer>.Create;
  with arr do
  begin
    for i := 0 to 50000000 do
      add(i);

    Free;
  end;
end;

procedure Test;
var
  arr: TArrayEx<Integer>;
  i: Integer;
begin
  with arr do
  begin

    init;

    for i := 0 to 50000000 do
      add(i);

    Free;
  end;
end;

procedure Start(func: Pointer);
var
  T: Int64;
type
  call = procedure();
begin
  QueryPerformanceCounter(T);
  call(func)();
  Writeln(PrintTime(T));
end;

begin
  try
    Writeln('TArrayEx:');
    Start(@Test);
    Start(@Test);
    Start(@Test);

    Writeln('TList: ');
    Start(@Test2);
    Start(@Test2);
    Start(@Test2);
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  Readln;

end.

TArrayEx:
0.583250
0.581066
0.617087

TList:
1.576700
1.573458
1.624675

TArrayEx:
0.822943
0.861437
0.847995
0.840008
0.838371

TList:
1.458338
1.444993
1.435181
1.460552
1.458031

TArrayEx:
0.585735
0.634947
0.584339
0.573577
0.576069

TList:
1.515850
1.532542
1.568213
1.527930
1.541805

if (CurIndex <= CurrentLength) and (NewIndex <= CurrentLength) then

if ((CurIndex >= 0) and (CurIndex <= CurrentLength)) and ((NewIndex >= 0) and (NewIndex <= CurrentLength)) then

 tlist.delete(-5);

procedure Insert(Index: NativeUInt; Item: T);