一個簡易無鎖池

一個簡易 無鎖池

1.預先開辟2的冪大小容量，可自增，每次翻倍

2.僅提供思路，工程應用可靠性還不確定。

// 無鎖池
// hezihang @cnblogs.com

//20160608 修正可能存在同時Grow的Bug

unit utAtomPool;

interface

Uses
  SysUtils,
  SyncObjs;

Type
  Int32 = Integer;
  UInt32 = Cardinal;

  TAtomPoolAbstract = Class
  private
    FWritePtr: Int32;
    FReadPtr: Int32;
    FHighBound: UInt32;
    FData: array of Pointer;
    FLock: Int32;
    FCheckThread: Integer;
    procedure CheckGrow;
  Protected
    function AllocItemResource: Pointer; virtual; abstract;
    procedure FreeItemResource(Item: Pointer); virtual; abstract;
    function GetSize: UInt32;
    procedure AllocResources;
    procedure FreeResources;
    procedure Grow;
  Public
    function Get: Pointer;
    procedure Put(Item: Pointer);
    Constructor Create(Size: UInt32); Virtual;
    Destructor Destroy; Override;
    property Size: UInt32 read GetSize;
  End;

  TAtomPoolMem4K = class(TAtomPoolAbstract)
    function AllocItemResource: Pointer; override;
    procedure FreeItemResource(Item: Pointer); override;
  end;

Implementation

{$IF defined(WIN32) or defined(WIN64)}

uses Windows;
{$ELSE}
{$I InterlockedAPIs.inc}
{$ENDIF}

const
  MAXTHREADCOUNT = 1000; // 從池中申請資源最大線程數
  // 創建池，大小必須是2的冪,並且必須大於MAXTHREADCOUNT

Constructor TAtomPoolAbstract.Create(Size: UInt32);
var
  OK: Boolean;
Begin
  Inherited Create;
  OK := (Size and (Size - 1) = 0);
  OK := OK and (Size > MAXTHREADCOUNT);

  if not OK then
    raise Exception.Create(Format('池長度必須大於%d並為2的冪', [MAXTHREADCOUNT]));

  try
    SetLength(FData, Size);
    FHighBound := Size - 1;
    FWritePtr := FHighBound;
    FReadPtr := 0;
  except
    Raise Exception.Create('池申請內存失敗');
  end;
End;

Destructor TAtomPoolAbstract.Destroy;
Begin
  FreeResources;
  SetLength(FData, 0);
  Inherited;
End;

procedure TAtomPoolAbstract.AllocResources;
var
  i: UInt32;
begin
  for i := 0 to FHighBound do
    FData[i] := AllocItemResource;
end;

procedure TAtomPoolAbstract.FreeResources;
var
  i: UInt32;
begin
  for i := FHighBound downto 0 do
    Self.FreeItemResource(FData[i]);
end;

procedure TAtomPoolAbstract.CheckGrow;
begin
  if FLock > 0 then
  begin
    while FLock = 1 do
      Sleep(0);
    InterlockedIncrement(FCheckThread);
    while FLock > 0 do
      Sleep(1);
  end;
end;

procedure TAtomPoolAbstract.Put(Item: Pointer);
var
  N: UInt32;
begin
  CheckGrow;
  N := InterlockedIncrement(FWritePtr);
  FData[N and FHighBound] := Item;
end;

Function TAtomPoolAbstract.Get: Pointer;
var
  N, M, K: UInt32;
begin
  N := FWritePtr;
  M := FReadPtr;
  K := (M + MAXTHREADCOUNT) and FHighBound;
  if ((N > M) and (N < K)) or ((N < M) and (N > K)) then
  begin
    Grow
  end;

  N := InterlockedIncrement(FReadPtr);
  Result := FData[M and FHighBound];
end;

function TAtomPoolAbstract.GetSize: UInt32;
begin
  Result := FHighBound + 1;
end;

procedure TAtomPoolAbstract.Grow;
var
  i, N: Integer;
begin
  if InterlockedCompareExchange(FLock, 1, 0)=0 then
  begin
    N := Length(FData);
    SetLength(FData, N + N);
    for i := N to High(FData) do
      FData[i] := AllocItemResource;
    InterlockedIncrement(FLock);
    Sleep(MAXTHREADCOUNT * 4);
    // while (FCheckThread<MAXTHREADCOUNT) do Sleep(0);
    FHighBound := High(FData);
    FCheckThread := 0;
    InterlockedExchange(FLock, 0);
  end
  else
    CheckGrow;
end;

{ TAtomPoolMem4K }

function TAtomPoolMem4K.AllocItemResource: Pointer;
begin
  GetMem(Result, 4096);
end;

procedure TAtomPoolMem4K.FreeItemResource(Item: Pointer);
begin
  FreeMem(Item, 4096);
end;

End.