无锁对象池与无锁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<T> = procedure(var AObject: T) of object;
// 释放对象实例事件
TDestroyObjectInstance<T> = procedure(var AObject: T) of object;
TLockFreeObjectPool<T> = 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<T>;
// 释放对象实例事件
FDestroyObjectInstance: TDestroyObjectInstance<T>;
// 内部压入操作
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<T>
read FCreateObjectInstance write FCreateObjectInstance;
// 释放对象实例事件
property DoDestroyObjectInstance: TDestroyObjectInstance<T>
read FDestroyObjectInstance write FDestroyObjectInstance;
End;
implementation
constructor TLockFreeObjectPool<T>.Create();
begin
inherited Create;
FDoDestroy := false;
FBuckets := nil;
FAvailableItems := nil;
end;
destructor TLockFreeObjectPool<T>.Destroy;
begin
FDoDestroy := true;
// 清除Hash表和元素
Clear;
inherited Destroy;
end;
// 清除Hash表和元素
procedure TLockFreeObjectPool<T>.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<T>.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<T>.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<T>.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<T>.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<T>.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<T>.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<T>.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<IInterface>;
// 创建对象实例事件
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 thenExit;
IUnknown(anInstance) := nil;
end;
3、创建并初始化对象池
// 无锁对象池，用于建立插件池，每一个工厂建立一个插件池
FPluginPool := TLockFreeObjectPool<IInterface>.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