Vulkan/projects/utils/uvkuAllocationHandler.pas

unit uvkuAllocationHandler;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,
  Vulkan;

type
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TvkuAllocationHandler = class(TObject)
  private
    fAllocCallbacks: PVkAllocationCallbacks;
  protected
    function  AllocateMemory(const aSize: VkSize; const aAlignment: VkSize; const aScope: TVkSystemAllocationScope): PVkVoid; virtual;
    function  ReallocateMemory(const aOriginal: PVkVoid; const aSize: VkSize; const aAlignment: VkSize; const aScope: TVkSystemAllocationScope): PVkVoid; virtual;
    procedure FreeMemory(const aMemory: PVkVoid); virtual;

    procedure InternalAllocationNotification(const aSize: VkSize; const aType: TVkInternalAllocationType; const aScope: TVkSystemAllocationScope);
    procedure InternalFreeNotification(const aSize: VkSize; const aType: TVkInternalAllocationType; const aScope: TVkSystemAllocationScope);
  public
    function GetAllocationCallbacks: TVkAllocationCallbacks;
    function GetAllocationCallbacksPtr: PVkAllocationCallbacks;

    constructor Create;
    destructor Destroy; override;
  end;

implementation

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function AllocateMemoryCallback(aUserData: PVkVoid; aSize: VkSize; aAlignment: VkSize; aScope: TVkSystemAllocationScope): PVkVoid; stdcall;
begin
  result := TvkuAllocationHandler(aUserData).AllocateMemory(aSize, aAlignment, aScope);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ReallocateMemoryCallback(aUserData: PVkVoid; aOriginal: PVkVoid; aSize: VkSize;
  aAlignment: VkSize; aScope: TVkSystemAllocationScope): PVkVoid; stdcall;
begin
  result := TvkuAllocationHandler(aUserData).ReallocateMemory(aOriginal, aSize, aAlignment, aScope);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure FreeMemoryCallback(aUserData: PVkVoid; aMemory: PVkVoid); stdcall;
begin
  TvkuAllocationHandler(aUserData).FreeMemory(aMemory);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure InternalAllocationCallback(aUserData: PVkVoid; aSize: VkSize; aType: TVkInternalAllocationType; aScope: TVkSystemAllocationScope); stdcall;
begin
  TvkuAllocationHandler(aUserData).InternalAllocationNotification(aSize, aType, aScope);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure InternalFreeCallback(aUserData: PVkVoid; aSize: VkSize; aType: TVkInternalAllocationType; aScope: TVkSystemAllocationScope); stdcall;
begin
  TvkuAllocationHandler(aUserData).InternalFreeNotification(aSize, aType, aScope);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TvkuAllocationHandler//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TvkuAllocationHandler.AllocateMemory(const aSize: VkSize; const aAlignment: VkSize; const aScope: TVkSystemAllocationScope): PVkVoid;
begin
  result := System.GetMemory(aSize);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TvkuAllocationHandler.ReallocateMemory(const aOriginal: PVkVoid; const aSize: VkSize; const aAlignment: VkSize; const aScope: TVkSystemAllocationScope): PVkVoid;
begin
  result := System.ReAllocMemory(aOriginal, aSize);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TvkuAllocationHandler.FreeMemory(const aMemory: PVkVoid);
begin
  System.FreeMemory(aMemory);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TvkuAllocationHandler.InternalAllocationNotification(const aSize: VkSize; const aType: TVkInternalAllocationType; const aScope: TVkSystemAllocationScope);
begin
  // DUMMY
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TvkuAllocationHandler.InternalFreeNotification(const aSize: VkSize; const aType: TVkInternalAllocationType; const aScope: TVkSystemAllocationScope);
begin
  // DUMMY
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TvkuAllocationHandler.GetAllocationCallbacks: TVkAllocationCallbacks;
begin
  result := GetAllocationCallbacksPtr^;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TvkuAllocationHandler.GetAllocationCallbacksPtr: PVkAllocationCallbacks;
begin
  if not Assigned(fAllocCallbacks) then begin
    new(fAllocCallbacks);
    FillByte(fAllocCallbacks^, SizeOf(result), 0);
    fAllocCallbacks^.pUserData              := self;
    fAllocCallbacks^.pfnAllocation          := @AllocateMemoryCallback;
    fAllocCallbacks^.pfnReallocation        := @ReallocateMemoryCallback;
    fAllocCallbacks^.pfnFree                := @FreeMemoryCallback;
    fAllocCallbacks^.pfnInternalAllocation  := @InternalAllocationCallback;
    fAllocCallbacks^.pfnInternalFree        := @InternalFreeCallback;
  end;
  result := fAllocCallbacks;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TvkuAllocationHandler.Create;
begin
  inherited Create;
  fAllocCallbacks := nil;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TvkuAllocationHandler.Destroy;
begin
  if Assigned(fAllocCallbacks) then begin
    Dispose(fAllocCallbacks);
    fAllocCallbacks := nil;
  end;
  inherited Destroy;
end;

end.