Vulkan/projects/utils/uvkuAllocationHandler.pas

unit uvkuAllocationHandler;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,
  Vulkan;

type
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TvkuAllocationHandler = class(TObject)
  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;
  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
  FillByte(result, SizeOf(result), 0);
  result.pUserData              := self;
  result.pfnAllocation          := @AllocateMemoryCallback;
  result.pfnReallocation        := @ReallocateMemoryCallback;
  result.pfnFree                := @FreeMemoryCallback;
  result.pfnInternalAllocation  := @InternalAllocationCallback;
  result.pfnInternalFree        := @InternalFreeCallback;
end;

end.