之前看过MS的无锁单链表，效率确实非常高，但有点遗憾是Windows的Api函数，不能跨平台使用，而且要求保存的数据必须内存对齐，很不爽，当时看了具体汇编实现后，还是没完全明白过来为什么需要内存对齐，不知道该怎么实现为跨平台的无锁单链表，在之后写无锁Hash时，仔细研究并测试了Delphi原子操作TInterlocked.CompareExchange函数，猛然醒悟。
此无锁链表可跨平台使用，并且不需要数据的内存对齐，效率与MS的无锁单链表相同，有点爽。
无锁单链表的应用场景在对保存的数据push和pop无先进先出要求，单纯的实现对象、结构指针等数据的存取，这点在《DelphiXE10.2.3实现线程安全访问数据和对象（四）——实现原子自旋锁的无锁对象池》中得到了应用，实现对象池中记录哪些对象是可以被取出的，经过实际测试，效率确实很高。
{ ********************************************************************************
组件名称：无锁链表
组件说明：
1、多线程安全读写，没有使用线程互斥锁类低效率方法
2、使用一个单独的空闲链表来实现一个简单的内存池，避免大量的Getmem和Freemem操作
3、同时，由于使用了链表内存池，就把链表结构封装在内部，使调用者无法操作链表结构，增加可靠性
4、重要的是，线程读写均衡的情况下，读写效率也奇高
5、更重要的，跨平台！
创建者：晴空无彩虹 QQ群：733975324
版本号：0.1
创建日期：2018-05-10
注意事项：
******************************************************************************** }
unit uLockFreeLinkedList;
interface
uses System.Classes, System.SyncObjs, System.SysUtils;
type
// 创建新的单链表和元素事件，调用者要根据需要决定是否实现该自动创建对象过程
TCreateSingleLinkedList<T> = procedure(var Value: T) of object;
// 释放单链表和元素事件，调用者必须实现该对象释放过程
TDestroySingleLinkedList<T> = procedure(var Value: T) of object;
// 无锁链表
TLockFreeLinkedList<T> = Class
private type
// 单链表
PSingleLinkedList = ^TSingleLinkedList;
TSingleLinkedList = record
Element: T;
Next: PSingleLinkedList;
end;
private
FLinkedListHead: PSingleLinkedList; // 链表头
FIdleLinkedListHead: PSingleLinkedList; // 空闲链表
FValidCount: integer; // 有效链表个数
FIdleCount: integer; // 空闲链表个数
FDoDestroy: boolean; // 准备释放对象了，赶快退出通道
FCreateSingleLinkedList: TCreateSingleLinkedList<T>;
FDestroySingleLinkedList: TDestroySingleLinkedList<T>;
function GetValidCount: integer;
function GetIdleCount: integer;
// 内部压入操作
function InternalPush(var Value: T): boolean;
// 内部弹出操作
function InternalPop(var Value: T): boolean;
// 压入空闲链表
procedure PushIdleLinkedList(var SingleLinkedList: PSingleLinkedList);
// 弹出空闲链表
function PopIdleLinkedList: PSingleLinkedList;
public
constructor Create();
destructor Destroy; override;
function Push(var Value: T): boolean;
function Pop(var Value: T): boolean;
// 有效链表个数
property ValidCount: integer read GetValidCount;
// 空闲链表个数
property IdleCount: integer read GetIdleCount;
// 创建新的单链表和元素事件
property DoCreateSingleLinkedList: TCreateSingleLinkedList<T>
read FCreateSingleLinkedList write FCreateSingleLinkedList;
// 释放单链表和元素事件
property DoDestroySingleLinkedList: TDestroySingleLinkedList<T>
read FDestroySingleLinkedList write FDestroySingleLinkedList;
End;
implementation
constructor TLockFreeLinkedList<T>.Create();
begin
inherited;
FValidCount := 0;
FIdleCount := 0;
FDoDestroy := false;
FLinkedListHead := nil;
FIdleLinkedListHead := nil;
end;
destructor TLockFreeLinkedList<T>.Destroy;
var
Value: T;
SingleLinkedList: PSingleLinkedList;
begin
FDoDestroy := true;
sleep(10);
// 先释放所有元素
while FLinkedListHead <> nil do
begin
self.InternalPop(Value);
// 将单链表中的元素都交给调用者去释放
if Assigned(DoDestroySingleLinkedList) then
DoDestroySingleLinkedList(Value);
end;
// 再释放所有链表
while FIdleLinkedListHead <> nil do
begin
SingleLinkedList := PopIdleLinkedList();
freemem(SingleLinkedList);
end;
inherited;
end;
function TLockFreeLinkedList<T>.GetValidCount: integer;
begin
result := TInterlocked.CompareExchange(FValidCount, 0, 0);
end;
function TLockFreeLinkedList<T>.GetIdleCount: integer;
begin
result := TInterlocked.CompareExchange(FIdleCount, 0, 0);
end;
// 压入空闲链表
procedure TLockFreeLinkedList<T>.PushIdleLinkedList(var SingleLinkedList
: PSingleLinkedList);
begin
while true do
begin
SingleLinkedList^.Next := FIdleLinkedListHead;
if TInterlocked.CompareExchange(Pointer(FIdleLinkedListHead),
SingleLinkedList, SingleLinkedList^.Next) <> SingleLinkedList^.Next then
continue;
TInterlocked.Increment(FIdleCount);
exit;
end;
end;
// 弹出空闲链表
function TLockFreeLinkedList<T>.PopIdleLinkedList: PSingleLinkedList;
begin
while true do
begin
result := FIdleLinkedListHead;
if (result = nil) and (not FDoDestroy) then
begin
Getmem(result, sizeof(TSingleLinkedList));
result^.Next:=nil;
exit;
end;
if TInterlocked.CompareExchange(Pointer(FIdleLinkedListHead), result^.Next,
result) <> result then
continue;
TInterlocked.Decrement(FIdleCount);
exit;
end;
end;
function TLockFreeLinkedList<T>.Push(var Value: T): boolean;
begin
result := false;
// 如果已经在释放对象，就直接退出
if FDoDestroy then
exit;
// 内部压入操作
result := InternalPush(Value);
end;
function TLockFreeLinkedList<T>.Pop(var Value: T): boolean;
begin
result := false;
// 如果已经在释放对象，就直接退出
if FDoDestroy then
exit;
// 内部弹出操作
result := InternalPop(Value);
end;
// 内部压入操作
function TLockFreeLinkedList<T>.InternalPush(var Value: T): boolean;
var
SingleLinkedList: PSingleLinkedList;
begin
result := false;
// 从空闲链表中取一个出来使用
SingleLinkedList := PopIdleLinkedList();
if SingleLinkedList <> nil then
begin
SingleLinkedList.Element := Value;
while true do
begin
SingleLinkedList^.Next := FLinkedListHead;
if TInterlocked.CompareExchange(Pointer(FLinkedListHead),
SingleLinkedList, SingleLinkedList^.Next) <> SingleLinkedList^.Next then
continue;
TInterlocked.Increment(FValidCount);
result := true;
exit;
end;
end;
end;
// 内部弹出操作
function TLockFreeLinkedList<T>.InternalPop(var Value: T): boolean;
var
SingleLinkedList: PSingleLinkedList;
begin
result := false;
while true do
begin
SingleLinkedList := FLinkedListHead;
if SingleLinkedList = nil then
if Assigned(DoCreateSingleLinkedList) and not FDoDestroy then
begin
DoCreateSingleLinkedList(Value);
result := true;
exit;
end
else // 如果调用者没有创建单链表事件，就直接返回
exit;
if TInterlocked.CompareExchange(Pointer(FLinkedListHead),
SingleLinkedList^.Next, SingleLinkedList) <> SingleLinkedList then
continue;
Value := SingleLinkedList^.Element;
// 压入空闲链表
PushIdleLinkedList(SingleLinkedList);
TInterlocked.Decrement(FValidCount);
result := true;
exit;
end;
end;
end.
使用方法比较简单，源码备注都基本写了，使用时就通过push和pop存取对象，如果调用者实例化了自动创建对象事件，在链表为空的情况下，会调用该事件，使pop过程一定会取到一个可用对象。
需要注意的是，单链表pop出对象后，是否push回链表取决与调用者，但如果不再push回去，则调用者自己处理该对象的释放过程。
QQ群：DELPHI开发者群：733975324