Aligned Arrays Implementation

This is an implementation of page size aligned arrays. It is interchangeable with the standard dynamic array type and can implicitly convert between the two. The
TAlignedArray<T>
type exposes aproximately the same functionality as dynamic arrays, but with page sized and aligned pointers. It uses the new management operators to allocate and deallocate memory.

Please note, that when you assign one aligned array to another aligned array, new page aligned memory is allocated and memory is copied. If you want to prevent this from happening you should either pass the arrays as constref or by reference. You can use the type
PAlignedArrayType
as a way of passing references safely without falling back to using
var
arguments.

Here is the basic usage of
TAlignedArray<T>
:
procedure Test;
var
  A, B: TAlignedArray<TPoint>;
  C: array of TPoint;
  P: TPoint;
begin
  A.Push(Point(12, 15));
  A.Push(Point(8, 4));
  B := A;
  WriteLn('Memory address of first A item ', IntPtr(A[0]));
  WriteLn('First item of A is page aligned: ', IntPtr(A[0]) mod PageSize = 0);
  WriteLn('Memory address of first B item ', IntPtr(B[0]));
  WriteLn('First item of B is page aligned: ', IntPtr(B[0]) mod PageSize = 0);
  WriteLn('Points in A:');
  for P in A do
    WriteLn('X: ', P.X, ', Y: ', P.Y);
  WriteLn('Points in B:');
  for P in B do
    WriteLn('X: ', P.X, ', Y: ', P.Y);
  C := A;
  WriteLn('Copied to standard dynamic array C');
  WriteLn('Points in C:');
  for P in C do
    WriteLn('X: ', P.X, ', Y: ', P.Y);
end;
Which results in this:
Memory address of first A item 14606336
First item of A is page aligned: TRUE
Memory address of first B item 14614528
First item of B is page aligned: TRUE
Points in A:
X: 12, Y: 15
X: 8, Y: 4
Points in B:
X: 12, Y: 15
X: 8, Y: 4
Copied to standard dynamic array C
Points in C:
X: 12, Y: 15
X: 8, Y: 4
If you want to increase the speed when working with aligned arrays, you can set the length directly on an aligned array, request the first item, and safely access subsequent items using the
Inc
procedure.

And here is the implementation of
TAlignedArray<T>
:
unit AlignArrays;

{$mode delphi}

interface

type
  TMemoryEnumerator<T> = class(TInterfacedObject, IEnumerator<T>)
  private
    type PItem = ^T;
  private
    FMemory: Pointer;
    FPosition: Integer;
    FCount: Integer;
  public
    constructor Create(Memory: Pointer; Count: Integer);
    function GetCurrent: T;
    function MoveNext: Boolean;
    procedure Reset;
    property Current: T read GetCurrent;
  end;

  TAlignedArray<T> = record
  public
    type
      TArray = array of T;
      TAlignedArrayType = TAlignedArray<T>;
      PAlignedArrayType = ^TAlignedArrayType;
      TReference = ^T;
      TValue = T;
      IEnumeratorType = IEnumerator<T>;
    function GetEnumerator: IEnumeratorType;
  private
    FPage: Pointer;
    FCount: Integer;
    FLength: Integer;
    procedure SetLength(Value: Integer);
    function GetReference(Index: Integer): TReference;
    function GetItem(Index: Integer): TValue;
    procedure SetItem(Index: Integer; const Value: TValue);
  public
    class operator Initialize(var A: TAlignedArrayType);
    class operator Finalize(var A: TAlignedArrayType);
    class operator Copy(constref Source: TAlignedArrayType; var Dest: TAlignedArrayType);
    class operator Implicit(const Value: TAlignedArrayType): TArray;
    class operator Implicit(const Value: TArray): TAlignedArrayType;
    class operator Implicit(const Value: array of T): TAlignedArrayType;
    procedure Clear;
    procedure Push(const Item: TValue);
    function Pop: TValue;
    property Length: Integer read FLength write SetLength;
    property Reference[Index: Integer]: TReference read GetReference; default;
    property Item[Index: Integer]: TValue read GetItem write SetItem;
  end;

const
  PageSize = 1024 * 4;

function PagesAlloc(Count: Integer): Pointer;
procedure PagesFree(var Page: Pointer);

implementation

{$ifdef unix}
const
  libc = 'libc';

function posix_memalign(out ptr: Pointer; alignment: IntPtr; size: IntPtr): Integer; cdecl; external libc;
procedure free(ptr: Pointer); cdecl; external libc;
{$endif}
{$ifdef windows}
const
  msvcrt = 'msvcrt.dll';

function _aligned_malloc(size: IntPtr; alignment: IntPtr): IntPtr; cdecl; external msvcrt;
function _aligned_free(memblock: IntPtr): IntPtr; cdecl; external msvcrt;
{$endif}

function PagesAlloc(Count: Integer): Pointer;
{$ifdef unix}
var
  I: Integer;
begin
  if Count > 0 then
  begin
    I := posix_memalign(Result, PageSize, Count * PageSize);
    if I <> 0 then
      Result := nil;
  end
  else
    Result := nil;
end;
{$endif}
{$ifdef windows}
begin
  if Count > 0 then
    Result := _aligned_malloc(Count * PageSize, PageSize)
  else
    Result := nil;
end;
{$endif}

procedure PagesFree(var Page: Pointer);
var
  P: Pointer;
begin
  P := Page;
  Page := nil;
  if P <> nil then
  {$ifdef unix}
    free(P);
  {$endif}
  {$ifdef windows}
    _aligned_free(P);
  {$endif}
end;

{ TMemoryEnumerator<T> }

constructor TMemoryEnumerator<T>.Create(Memory: Pointer; Count: Integer);
begin
  inherited Create;
  FMemory := Memory;
  FPosition := -1;
  FCount := Count;
end;

function TMemoryEnumerator<T>.GetCurrent: T;
var
  Item: PItem;
begin
  Item := FMemory;
  Inc(Item, FPosition);
  Result := Item^;
end;

function TMemoryEnumerator<T>.MoveNext: Boolean;
begin
  Inc(FPosition);
  Result := FPosition < FCount;
end;

procedure TMemoryEnumerator<T>.Reset;
begin
  FPosition := -1;
end;

{ TAlignedArray<T> }

function TAlignedArray<T>.GetEnumerator: IEnumeratorType;
begin
  Result := TMemoryEnumerator<T>.Create(FPage, FLength);
end;

class operator TAlignedArray<T>.Initialize(var A: TAlignedArrayType);
begin
  A.FPage := nil;
  A.FCount := 0;
  A.FLength := 0;
end;

class operator TAlignedArray<T>.Finalize(var A: TAlignedArrayType);
begin
  A.Clear;
end;

class operator TAlignedArray<T>.Copy(constref Source: TAlignedArrayType; var Dest: TAlignedArrayType);
var
  S, D: TReference;
  I: Integer;
begin
  if @Source = @Dest then
    Exit;
  Dest.Length := Source.Length;
  S := Source.FPage;
  D := Dest.FPage;
  for I := 0 to Source.Length - 1 do
  begin
    D^ := S^;
    Inc(S);
    Inc(D);
  end;
end;

class operator TAlignedArray<T>.Implicit(const Value: TAlignedArrayType): TArray;
var
  I: Integer;
begin
  System.SetLength(Result, Value.Length);
  for I := 0 to Value.Length - 1 do
    Result[I] := Value.Item[I];
end;

class operator TAlignedArray<T>.Implicit(const Value: TArray): TAlignedArrayType;
var
  R: TReference;
  I: Integer;
begin
  Result.Length := System.Length(Value);
  R := Result.FPage;
  for I := 0 to Result.Length - 1 do
  begin
    R^ := Value[I];
    Inc(R);
  end;
end;

class operator TAlignedArray<T>.Implicit(const Value: array of T): TAlignedArrayType;
var
  R: TReference;
  I: Integer;
begin
  Result.Length := System.Length(Value);
  R := Result.FPage;
  for I := 0 to Result.Length - 1 do
  begin
    R^ := Value[I];
    Inc(R);
  end;
end;

procedure TAlignedArray<T>.Clear;
begin
  Length := 0;
end;

procedure TAlignedArray<T>.Push(const Item: TValue);
var
  I: Integer;
begin
  I := FLength;
  SetLength(FLength + 1);
  GetReference(I)^ := Item;
end;

function TAlignedArray<T>.Pop: TValue;
var
  I: Integer;
begin
  I := FLength - 1;
  if I > -1 then
  begin
    Result := GetReference(I)^;
    GetReference(I)^ := Default(TValue);
    SetLength(I);
  end;
end;

procedure TAlignedArray<T>.SetLength(Value: Integer);
var
  Buffer: TReference;
  A, B: TReference;
  I: Integer;
begin
  if Value < 1 then
  begin
    if FLength = 0 then
      Exit;
    A := FPage;
    for I := 0 to FLength - 1 do
    begin
      A^ := Default(TValue);
      Inc(A);
    end;
    FCount := 0;
    FLength := 0;
    PagesFree(FPage);
  end
  else if Value < FLength then
  begin
    A := FPage;
    Inc(A, FLength - 1);
    for I := FLength -1 downto Value do
    begin
      A^ := Default(TValue);
      Dec(A);
    end;
    FLength := Value;
  end
  else if Value > FLength then
  begin
    I := Value div SizeOf(TValue) + 1;
    if I > FCount then
    begin
      Buffer := PagesAlloc(I);
      FillChar(Buffer^, PageSize * I, 0);
      B := Buffer;
      for I := 0 to Value - 1 do
      begin
        B^ := Default(TValue);
        Inc(B);
      end;
      A := FPage;
      B := Buffer;
      for I := 0 to FLength - 1 do
      begin
        B^ := A^;
        A^ := Default(TValue);
        Inc(A);
        Inc(B);
      end;
      PagesFree(FPage);
      FPage := Buffer;
      FCount := Value div SizeOf(TValue) + 1;
      FLength := Value;
    end
    else
    begin
      A := FPage;
      Inc(A, FLength);
      for I := FLength to Value - 1 do
      begin
        A^ := Default(TValue);
        Inc(A);
      end;
      FLength := Value;
    end;
  end;
end;

function TAlignedArray<T>.GetReference(Index: Integer): TReference;
begin
  if Index < 0 then
    Exit(nil);
  if Index > FLength - 1 then
    Exit(nil);
  Result := TReference(FPage);
  if Index > 0 then
    Inc(Result, Index);
end;

function TAlignedArray<T>.GetItem(Index: Integer): TValue;
begin
  Result := GetReference(Index)^;
end;

procedure TAlignedArray<T>.SetItem(Index: Integer; const Value: TValue);
begin
  GetReference(Index)^ := Value;
end;

end.