unit MemoryPool;

interface

uses
  DynamicQueue,
  Generics.Collections,
  Windows, Classes, SysUtils;

const
  _PageListCount = 12;
  _PageSizes : array [1.._PageListCount] of integer = (
    32, 64, 128, 256, 512, 1024, 1024*2, 1024*4, 1024*8, 1024*16, 1024*32, 1024*64
  );

type
  TMemoryPage = class
  private
    FPageListIndex: integer;
  private
    FSize: integer;
    FData: pointer;
  public
    Tag: DWord;

    constructor Create(APageListIndex,ASize:integer); reintroduce;
    destructor Destroy; override;

    procedure Assign(AMemoryPage:TMemoryPage);

    property Data : pointer read FData;
    property Size : integer read FSize;
  end;

  TMemoryPageList = class
  private
    FQueue : TDynamicQueue;
  private
    FIndex: integer;
  public
    constructor Create(AIndex:integer; ANeedThreadSafe:boolean); reintroduce;
    destructor Destroy; override;

    function GetMem(ASize:integer):TMemoryPage;
    procedure FreeMem(AMemoryPage:TMemoryPage);
  end;

  TMemoryPool = class
  private
    FPageListIndex : array [1.._PageListCount] of TMemoryPageList;
    FSize: integer;
    procedure clear_PageList;
  public
    constructor Create(ANeedThreadSafe:boolean); reintroduce;
    destructor Destroy; override;

    function GetMem(ASize:integer):TMemoryPage;
    procedure FreeMem(AMemoryPage:TMemoryPage);

    property Size : integer read FSize;
  end;

implementation

{ TMemoryPage }

procedure TMemoryPage.Assign(AMemoryPage: TMemoryPage);
begin
  if FData <> nil then FreeMem(FData);

  FPageListIndex := AMemoryPage.FPageListIndex;
  FSize := AMemoryPage.FSize;

  if FPageListIndex > 0 then begin
    GetMem(FData, _PageSizes[FPageListIndex]);
  end else begin
    if FSize > 0 then GetMem(FData, FSize)
    else FData := nil;
  end;

  if FSize > 0 then Move(AMemoryPage.FData^, FData^, FSize);  
end;

constructor TMemoryPage.Create(APageListIndex,ASize: integer);
begin
  inherited Create;

  FPageListIndex := APageListIndex;

  if APageListIndex > 0 then begin
    GetMem(FData, _PageSizes[APageListIndex]);
  end else begin
    if ASize > 0 then GetMem(FData, ASize)
    else FData := nil;
  end;

  FSize := ASize;
end;

destructor TMemoryPage.Destroy;
begin
  if FData <> nil then FreeMem(FData);

  FData := nil;
  FSize := 0;

  inherited;
end;

{ TMemoryPageList }

constructor TMemoryPageList.Create(AIndex: integer; ANeedThreadSafe:boolean);
begin
  inherited Create;

  FIndex := AIndex;

  FQueue := TDynamicQueue.Create(ANeedThreadSafe);
end;

destructor TMemoryPageList.Destroy;
var
  MemoryPage : TMemoryPage;
begin
  while FQueue.Pop(Pointer(MemoryPage)) do MemoryPage.Free;

  FreeAndNil(FQueue);

  inherited;
end;

procedure TMemoryPageList.FreeMem(AMemoryPage: TMemoryPage);
begin
  FQueue.Push(AMemoryPage);
end;

function TMemoryPageList.GetMem(ASize: integer): TMemoryPage;
begin
  FQueue.Pop(Pointer(Result));
  if Result = nil then Result := TMemoryPage.Create(FIndex, ASize);

  Result.FSize := ASize;
end;

{ TMemoryPool }

procedure TMemoryPool.clear_PageList;
var
  Loop : integer;
begin
  for Loop := Low(FPageListIndex) to High(FPageListIndex) do begin
    FPageListIndex[Loop].Free;
    FPageListIndex[Loop] := nil;
  end;
end;

constructor TMemoryPool.Create(ANeedThreadSafe:boolean);
var
  Loop : integer;
begin
  inherited Create;

  FSize := 0;

  for Loop := Low(FPageListIndex) to High(FPageListIndex) do begin
    FPageListIndex[Loop] := TMemoryPageList.Create(Loop, ANeedThreadSafe);
  end;
end;

destructor TMemoryPool.Destroy;
begin
  clear_PageList;

  inherited;
end;

procedure TMemoryPool.FreeMem(AMemoryPage: TMemoryPage);
begin
  InterlockedExchangeAdd(FSize, -AMemoryPage.Size);

  if AMemoryPage.FPageListIndex = 0 then begin
    AMemoryPage.Free;
  end else begin
    FPageListIndex[AMemoryPage.FPageListIndex].FreeMem(AMemoryPage);
  end;
end;

function TMemoryPool.GetMem(ASize: integer): TMemoryPage;
var
  iIndex : integer;
  Loop: Integer;
begin
  InterlockedExchangeAdd(FSize, ASize);

  iIndex := -1;
  for Loop := 1 to _PageListCount do
    if ASize <= _PageSizes[Loop] then begin
      iIndex := Loop;
      Break;
    end;

  // PageSize가 _PageSizeLimit 범위를 넘어서면 자유 크기로 저장한다
  if iIndex = -1 then begin
    Result := TMemoryPage.Create(0, ASize);
  end else begin
    Result := FPageListIndex[iIndex].GetMem(ASize);
  end;
end;

end.
