DelphiXE10.2.3实现线程安全访问数据和对象（四）——实现原子自旋锁的无锁对象池

    无锁对象池与无锁Hash是不同应用场景中使用，无锁Hash只是预先创建好Hash表（当然也可以动态Add）后，供调用者通过Key值快速找到保存的数据，并读取（这里就只能读取，不能做任何修改，否则非线程安全），要通过Add、Modify、ReMove这些过程才能修改，所以无锁Hash的使用场景是检索数据，而无锁对象池，却要考虑一个对象从对象池中获取后肯定同时会读写数据，就必须不能被其他线程再次获取相同对象，才能保障线程安全。

   所以在实现无锁对象池上，更多的是考虑如何保障不同线程不能访问到同一对象，还要考虑对象从对象池中取走后，要防止调用者没有归还对象而造成内存泄露，所以使用单独的内部链表来保存所有对象，再另外使用一个可用对象的链表来标识哪些对象是可以使用的，能够被新线程取走的，线程归还对象时，就只需要加入到可用链表中即可，这样避免大量的搜索工作。

  只是还需要完善调用者没有归还对象时，可用链表中始终就不会有该对象，这样这个对象就浪费了。

  好吧，翠花！上酸菜......上代码！

一、第一个输出对象的指针申明单元

也是按照我自身的应用场景来定义AObject: Pointer;，实际可根据自身需要修改

unit uCrossPlatformDefine;
interface
 uses System.Classes;
type
  PObjectInstance = ^TObjectInstance;
  TObjectInstance = record
    AObject: Pointer;
  end;
implementation

end.

二、以下是具体实现的单元文件

{ ********************************************************************************
  组件名称：无锁对象池
  组件说明：
  1、多线程安全读写，没有使用线程互斥锁类低效率方法
  2、使用一个单独的无锁可用链表来存取可用对象的指针，Push和Pop都从此链表操作
  即可防止调用者取出一个对象后报错或其他原因没有将对象归还回对象池，造成内存泄漏
  3、同时，由于使用了单独的链表方式，就把链表结构封装在内部，使调用者无法操作链表结构，增加可靠性
  4、重要的是，线程读写均衡的情况下，读写效率很高
  5、更重要的，跨平台！
  创建者：晴空无彩虹 QQ群：733975324
  版本号：0.1
  创建日期：2018-05-11
  注意事项：
  1、调用者要实现TCreateObjectInstance和TDestroyObjectInstance两个实例过程，用于自动创建和释放对象
  2、如果预先创建好对象存入对象池，调用Push(var AObject: T): boolean;
  3、Push(var ObjectInstance: PObjectInstance): boolean;过程只是用于从Pop(var ObjectInstance: PObjectInstance): boolean;中获取
     对象后再次保存回对象池使用，应注意使用pop try....finally push end;保护
  ******************************************************************************** }
unit uLockFreeObjectPool;
interface
uses System.Classes, System.SyncObjs, System.SysUtils,uCrossPlatformDefine;
type
  // 创建对象实例事件
  TCreateObjectInstance = procedure(var AObject: T) of object;
  // 释放对象实例事件
  TDestroyObjectInstance = procedure(var AObject: T) of object;
  TLockFreeObjectPool = Class
  private type
    PPHashItem = ^PHashItem;
    PHashItem = ^THashItem;
    THashItem = record
      AObject: T;
      InternalNext: PHashItem;
      ListNext: PHashItem;
    end;
  //public type
  private
    FBuckets: PHashItem;
    FAvailableItems: PHashItem;
    FDoDestroy: boolean;
    // 创建对象实例事件
    FCreateObjectInstance: TCreateObjectInstance;
    // 释放对象实例事件
    FDestroyObjectInstance: TDestroyObjectInstance;
    // 内部压入操作
    procedure InternalPush(var Bucket: PHashItem);
    // 内部弹出操作
    procedure InternalPop(var Bucket: PHashItem);
    // 压入可用链表
    procedure PushAvailableItems(var Bucket: PHashItem);
    // 弹出可用链表
    function PopAvailableItems(var Bucket: PHashItem): boolean;
    // 清除Hash表和元素
    procedure Clear;
  public
    constructor Create();
    destructor Destroy; override;
    // 压入对象值
    function Push(var ObjectInstance: PObjectInstance): boolean; overload;
    // 压入对象值
    function Push(var AObject: T): boolean; overload;
    // 弹出对象值
    function Pop(var ObjectInstance: PObjectInstance): boolean;
    // 创建对象实例事件
    property DoCreateObjectInstance: TCreateObjectInstance
      read FCreateObjectInstance write FCreateObjectInstance;
    // 释放对象实例事件
    property DoDestroyObjectInstance: TDestroyObjectInstance
      read FDestroyObjectInstance write FDestroyObjectInstance;
  End;
implementation
constructor TLockFreeObjectPool.Create();
begin
  inherited Create;
  FDoDestroy := false;
  FBuckets := nil;
  FAvailableItems := nil;
end;
destructor TLockFreeObjectPool.Destroy;
begin
  FDoDestroy := true;
  // 清除Hash表和元素
  Clear;
  inherited Destroy;
end;
// 清除Hash表和元素
procedure TLockFreeObjectPool.Clear;
var
  Bucket: PHashItem;
begin
  while FBuckets <> nil do
  begin
    InternalPop(Bucket);
    if Assigned(DoDestroyObjectInstance) then
      DoDestroyObjectInstance(Bucket^.AObject);
    //freemem(Bucket);
    dispose(Bucket);
  end;
end;
// 内部压入操作
procedure TLockFreeObjectPool.InternalPush(var Bucket: PHashItem);
begin
  while true do
  begin
    Bucket^.InternalNext := FBuckets;
    if TInterlocked.CompareExchange(Pointer(FBuckets), Bucket,
      Bucket^.InternalNext) <> Bucket^.InternalNext then
      continue;
    exit;
  end;
end;
// 内部弹出操作
procedure TLockFreeObjectPool.InternalPop(var Bucket: PHashItem);
begin
  while true do
  begin
    Bucket := FBuckets;
    if (Bucket = nil) then
      exit;
    if TInterlocked.CompareExchange(Pointer(FBuckets), Bucket^.InternalNext,
      Bucket) <> Bucket then
      continue;
    exit;
  end;
end;
// 压入可用链表
procedure TLockFreeObjectPool.PushAvailableItems(var Bucket: PHashItem);
begin
  while true do
  begin
    Bucket^.ListNext := FAvailableItems;
    if TInterlocked.CompareExchange(Pointer(FAvailableItems), Bucket,
      Bucket^.ListNext) <> Bucket^.ListNext then
      continue;
    exit;
  end;
end;
// 弹出可用链表
function TLockFreeObjectPool.PopAvailableItems
  (var Bucket: PHashItem): boolean;
begin
  result := false;
  while true do
  begin
    Bucket := FAvailableItems;
    if (Bucket = nil) then
      exit;
    if TInterlocked.CompareExchange(Pointer(FAvailableItems), Bucket^.ListNext,
      Bucket) <> Bucket then
      continue;
    result := true;
    exit;
  end;
end;
// 弹出对象和指针
function TLockFreeObjectPool.Pop(var ObjectInstance
  : PObjectInstance): boolean;
var
  Bucket: PHashItem;
  AObject:T;
begin
  result := false;
  if FDoDestroy then
    exit;
  result := PopAvailableItems(Bucket);
  // 如果无可用元素，则创建新的元素实例
  if not result then
    if Assigned(DoCreateObjectInstance) and (not FDoDestroy) then
    begin
      //getmem(Bucket, sizeof(THashItem));
      new(Bucket);
      DoCreateObjectInstance(AObject);
      Bucket^.AObject:=AObject;
      Bucket^.InternalNext := nil;
      Bucket^.ListNext := nil;
      // 压入内部
      InternalPush(Bucket);
    end;
  // 将转换过的指针返回给调用者
  ObjectInstance := PObjectInstance(Bucket);
  result := true;
end;
// 通过指针压入对象，外部调用程序不要去创建和释放ObjectInstance指针，本函数只用于通过pop弹出的指针回收
function TLockFreeObjectPool.Push(var ObjectInstance
  : PObjectInstance): boolean;
begin
  result := false;
  if FDoDestroy then
    exit;
  if ObjectInstance <> nil then
  begin
    // 直接压入可用链表即可
    PushAvailableItems(PHashItem(ObjectInstance));
    result := true;
  end;
end;
// 本函数是用于调用者新创建对象后第一次压入对象池
function TLockFreeObjectPool.Push(var AObject: T): boolean;
var
  Bucket: PHashItem;
begin
  result := false;
  if FDoDestroy then
    exit;
  //getmem(Bucket, sizeof(THashItem));
   new(Bucket);
  Bucket^.AObject := AObject;
  Bucket^.InternalNext := nil;
  Bucket^.ListNext := nil;
  // 内部压入操作
  InternalPush(Bucket);
  // 压入可用链表
  PushAvailableItems(Bucket);
  result := true;
end;

end.

三、调用方法

1、使用的单元

uses uLockFreeObjectPool,uCrossPlatformDefine

2、申明和调用者中实例化创建和删除事件

   // 无锁对象池，用于建立插件池

    FPluginPool: TLockFreeObjectPool;

   // 创建对象实例事件
    procedure DoCreateObjectInstance(var anInstance: IInterface);
    // 释放对象实例事件

    procedure DoDestroyObjectInstance(var anInstance: IInterface);

// 创建对象实例事件
procedure TXXXX.DoCreateObjectInstance(var anInstance: IInterface);

begin

  //这里写你自己的创建实例过程，下面这句只是举例

  InternalCreateInstance(anInstance);
end;


// 释放对象实例事件
procedure TXXXX.DoDestroyObjectInstance(var anInstance: IInterface);

begin

 //这里写你自己的释放实例过程，下面这句只是举例

  if IUnknown(anInstance) = nil then
    Exit;
  IUnknown(anInstance) := nil;

end;

3、创建并初始化对象池

// 无锁对象池，用于建立插件池，每一个工厂建立一个插件池
  FPluginPool := TLockFreeObjectPool.Create();
  // 创建对象实例事件
  FPluginPool.DoCreateObjectInstance := DoCreateObjectInstance;
  // 释放对象实例事件

  FPluginPool.DoDestroyObjectInstance := DoDestroyObjectInstance;

//你还可以在初始化过程中通过调用Push(var AObject: T): boolean;来预存入对象，存入多少个？你自己看着办，反正对象池是可以自动创建对象的

4、调用

var 

ObjectInstance: PObjectInstance): boolean;

begin

   if FPluginPool.Pop(ObjectInstance) then begin

      try

        //这里就可以通过ObjectInstance.AObject取到对象

      finally

          if FPluginPool.Push(ObjectInstance) then 

          ....//处理错误

      end;

   end;

end;

5、释放对象池

 //在调用者的释放过程中释放对象池

  if FPluginPool <> nil then

    freeandnil(FPluginPool);

QQ群：DELPHI开发者群：733975324