delphi原子操作实现简单内存池

unit AtomicMemoryPool;
//chatgpt写的
interface

uses
  Winapi.Windows, System.SysUtils;

type
  TAtomicMemoryPool = class
  private
    FMemoryList: PPointer;
    FCount: LONG;
    FBlockSize: Integer;
    FCapacity: Integer;
    function Pop: Pointer;
    procedure Push(P: Pointer);
  public
    constructor Create(BlockSize, Capacity: Integer);
    destructor Destroy; override;
    function Alloc: Pointer;
    procedure Free(P: Pointer);
  end;

implementation

{ TAtomicMemoryPool }

constructor TAtomicMemoryPool.Create(BlockSize, Capacity: Integer);
begin
  FBlockSize := BlockSize;
  FCapacity := Capacity;
  FMemoryList := AllocMem(SizeOf(Pointer) * FCapacity);
  FCount := 0;
end;

destructor TAtomicMemoryPool.Destroy;
var
  I: Integer;
begin
  for I := 0 to FCount - 1 do
    System.FreeMem(FMemoryList[I]);
  FreeMem(FMemoryList);
  inherited;
end;

function TAtomicMemoryPool.Alloc: Pointer;
begin
  Result := Pop;
  if Result = nil then
    Result := System.AllocMem(FBlockSize);
end;

procedure TAtomicMemoryPool.Free(P: Pointer);
begin
  if P <> nil then
    Push(P);
end;

function TAtomicMemoryPool.Pop: Pointer;
var
  LIndex: LONG;
begin
  repeat
    LIndex := InterlockedCompareExchange(FCount, 0, 0);
    if LIndex = 0 then
      Exit(nil);

    Result := FMemoryList[LIndex - 1];
  until InterlockedCompareExchange(FCount, LIndex - 1, LIndex) = LIndex;
end;

procedure TAtomicMemoryPool.Push(P: Pointer);
var
  LIndex: LONG;
begin
  repeat
    LIndex := InterlockedCompareExchange(FCount, 0, 0);

    if LIndex >= FCapacity then
    begin
      System.FreeMem(P);
      Exit;
    end;

    FMemoryList[LIndex] := P;
  until InterlockedCompareExchange(FCount, LIndex + 1, LIndex) = LIndex;
end;

end.