前面几篇已经介绍的比较清楚了,这里就直接上代码,代码经过FastMM4的内存溢出检查,正确使用情况下,不会存在内存溢出,代码是根据我自身特定使用场景实现的,所以应根据自身情况修改代码。
采用泛型和接口方式实现,生命周期自管理,不需要手动释放,但切记Delphi接口使用规范,所有直接引用的ILockFreeHash接口变量要置为nil,否则会出现AV。
另外再啰嗦下,该代码只是我在特定应用场景中使用的,所以我只会用于保存对象地址、指针类的数据,如果你要用于保存实体数值类型,自行修改TBucket的Value数据类型,嗯.......,没有太多时间思考这个问题,如果有更通用的方法,还望告知。
一、第一个接口和输出指针的单元文件:
unit uLockFreeHashInterface;
interface
uses System.Classes;
type
PBucket = ^TBucket;
TBucket = record
Value: Pointer;
end;
// 管理接口
ILockFreeHash = interface(IInterface)
['{65536AAB-FB84-4283-BA46-681FFBF9D3CA}']
// 得到桶和值指针
function GetValue(const Key: Uint64): PBucket;
// 归还桶指针
procedure SetValue(const Bucket: PBucket);
end;
implementation
end.
二、以下是具体实现的单元文件
{ ********************************************************************************
组件名称:无锁Hash链表
组件说明:
1、多线程安全读写,没有使用线程互斥锁类低效率方法
4、重要的是,线程读写均衡的情况下,读写效率很高
5、更重要的,跨平台!
创建者:晴空无彩虹 QQ群:733975324
版本号:0.1
创建日期:2018-05-13
注意事项:
1、用Add先创建Hash元素,再使用GetValue获取线程安全的指针,读取完成后,再用SetValue归还指针,注意使用try...finally保护
2、无锁Hash表的用途是对已保存值的快速检索和读取,所以千万不要在读取后直接修Value保存的内容,否则无法做到线程安全,切记!,修改数据过程只是为了不停机更新数据使用。
******************************************************************************** }unit uLockFreeHash;
interface
uses System.Classes, System.SysUtils,uLockFreeHashInterface;
type
TDeletionEvent<T> = procedure(var Value: T) of object;//调用者必须使用该事件
TLockFreeHash<T> = class(TComponent,ILockFreeHash)
private const
Const_LoopCount = 5; // 循环计数总个数
Const_CanReadWriteFlag = 0; // 可读写
Const_WritingFlag = 1; // 已写锁
Const_ReadingFlag = 2; // 已读锁
private type
PPHashItem = ^PHashItem;
PHashItem = ^THashItem;
THashItem = record
Value: T;
HashCode: Uint64;
Next: PHashItem;
ReadWriteLock: integer; // 读写锁标志
ReadCounter: integer; // 读计数器
Key: Uint64;
end;
private
FBuckets: array of PHashItem;
FCounter: Uint64; // 计数器
FDoDestroy: boolean;
FDeletionEvent: TDeletionEvent<T>;
// 根据KEY查找链表
function Find(const Key: Uint64): PPHashItem;
procedure BeginRead(var Bucket: PHashItem);
procedure EndRead(var Bucket: PHashItem);
procedure BeginWrite(var Bucket: PHashItem);
procedure EndWrite(var Bucket: PHashItem);
procedure Clear;
function GetCounter:Uint64;
public
constructor CreateHash(AOwner: TComponent;Size: Cardinal = 256);
destructor Destroy; override;
function Add(const Key: Uint64; const Value: T): boolean;
// 得到桶和值指针
function GetValue(const Key: Uint64): PBucket;
// 归还桶指针
procedure SetValue(const Bucket: PBucket);
function Modify(const Key: Uint64; const Value: T): boolean;
function Remove(const Key: Uint64): boolean;
property DoDeletion: TDeletionEvent<T> read FDeletionEvent
write FDeletionEvent;
property Count:Uint64 read GetCounter;
end;
implementation
constructor TLockFreeHash<T>.CreateHash(AOwner: TComponent;Size: Cardinal=256);
var
i: integer;
begin
inherited Create(AOwner);
FCounter:=0;
FDoDestroy := false;
SetLength(FBuckets, Size);
for i := 0 to Size - 1 do
FBuckets[i] := nil;
end;
destructor TLockFreeHash<T>.Destroy;
begin
FDoDestroy := true;//准备开始释放
sleep(10);//等待其他线程结束
Clear;
SetLength(FBuckets, 0);
inherited Destroy;
end;
function TLockFreeHash<T>.GetCounter:Uint64;
begin
result:=AtomicCmpExchange(FCounter,0,0);
end;
procedure TLockFreeHash<T>.Clear;
var
i: integer;
PrevBucket, NextBucket: PHashItem;
begin
for i := 0 to Length(FBuckets) - 1 do
begin
PrevBucket := FBuckets[i];
if PrevBucket = nil then
begin
FBuckets[i] := nil;
continue;
end;
while true do
begin
if AtomicCmpExchange(Pointer(FBuckets[i]), PrevBucket^.Next, PrevBucket)
<> PrevBucket then
begin
// 重新从原位置取
PrevBucket := FBuckets[i];
if PrevBucket = nil then
begin
FBuckets[i] := nil;
break;
end;
// 如果切换不出来,就循环,有可能是其他线程改变了上一个链表
continue;
end;
NextBucket := PrevBucket^.Next;
if Assigned(DoDeletion) then
DoDeletion(PrevBucket^.Value);
Dispose(PrevBucket);
AtomicIncrement(FCounter,-1);//计数器减1
if NextBucket = nil then
break;
PrevBucket := NextBucket;
end;
end;
end;
function TLockFreeHash<T>.Add(const Key: Uint64; const Value: T): boolean;
var
Hash: Uint64;
Bucket: PHashItem;
begin
result := false;
if FDoDestroy then
exit;
Hash := Key mod Cardinal(Length(FBuckets));
New(Bucket);
Bucket^.HashCode := Hash;
Bucket^.Key := Key;
Bucket^.ReadWriteLock := Const_CanReadWriteFlag;//每个链条都会有一个读写锁,以达到线程完全读写Value值
Bucket^.ReadCounter := 0;//读线程计数器
Bucket^.Value := Value;
while true do
begin
Bucket^.Next := FBuckets[Hash];
if AtomicCmpExchange(Pointer(FBuckets[Hash]), Bucket, Bucket^.Next) <>
Bucket^.Next then
continue;
AtomicIncrement(FCounter,1);//计数器加1
result := true;
exit;
end;
end;
function TLockFreeHash<T>.GetValue(const Key: Uint64): PBucket;
var
P: PHashItem;
begin
result := nil;
P := Find(Key)^;
if P <> nil then
begin
BeginRead(P); // 进入读锁,一定要使用 SetValue归还指针并解读锁
result := PBucket(P);
end;
end;
// 归还桶指针
procedure TLockFreeHash<T>.SetValue(const Bucket: PBucket);
var
P: PHashItem;
begin
P := PHashItem(Bucket);
EndRead(P);
end;
// 根据KEY查找链表
function TLockFreeHash<T>.Find(const Key: Uint64): PPHashItem;
var
Hash: Uint64;
begin
Hash := Key mod Cardinal(Length(FBuckets));
result := @FBuckets[Hash];
while result^ <> nil do
begin
if result^.Key = Key then // 直接用Hash值比较,速度会提高
exit
else
result := @result^.Next;
end;
end;
function TLockFreeHash<T>.Modify(const Key: Uint64; const Value: T): boolean;
var
P: PHashItem;
begin
result := false;
P := Find(Key)^;
if P <> nil then
begin
BeginWrite(P); // 进入写锁
try
result := true;
if Assigned(DoDeletion) then
DoDeletion(P^.Value); // 用事件方式交由外部调用过程去处理
P^.Value := Value;
result := true;
finally
EndWrite(P); // 退出写锁
end;
end;
end;
function TLockFreeHash<T>.Remove(const Key: Uint64): boolean;
var
P: PHashItem;
Prev: PPHashItem;
begin
result := false;
while not FDoDestroy do
begin
Prev := Find(Key);
P := Prev^;
// 找不到了,就表示已经被其他线程干掉了
if P = nil then
exit;
if AtomicCmpExchange(Pointer(Prev^), P^.Next, Prev^) <> Prev^ then
// 如果切换不出来,就循环,有可能是其他线程改变了上一个链表
continue;
BeginWrite(P); // 进入写锁,防止其他线程读取或写入
try
// 切换出来了,就开始释放
if Assigned(DoDeletion) then
DoDeletion(P^.Value); // 用事件方式交由外部调用过程去处理
Dispose(P); // 由于是释放
AtomicIncrement(FCounter,-1);//计数器减1
result := true;
finally
if not result then
EndWrite(P); // 退出写锁
end;
end;
end;
procedure TLockFreeHash<T>.BeginRead(var Bucket: PHashItem);
var
LoopCount: integer;
begin
LoopCount := 0;
// 如果有写操作,就等待写锁结束,没有写锁,就置成读锁
while AtomicCmpExchange(Bucket^.ReadWriteLock, Const_ReadingFlag,
Const_CanReadWriteFlag) = Const_WritingFlag do
begin
// 每隔5次等待1毫秒,避免线程循环争用资源,造成线程死锁
inc(LoopCount);
if LoopCount >= Const_LoopCount then
begin
sleep(1);
LoopCount := 0;
end;
end;
// 读计数器加1
AtomicIncrement(Bucket^.ReadCounter, 1);
end;
procedure TLockFreeHash<T>.EndRead(var Bucket: PHashItem);
begin
// 读锁计数器减一,如果是最后一个,就将锁标志置为可读写
if AtomicIncrement(Bucket^.ReadCounter, -1) = 0 then
AtomicExchange(Bucket^.ReadWriteLock, Const_CanReadWriteFlag);
end;
// 进入写锁
procedure TLockFreeHash<T>.BeginWrite(var Bucket: PHashItem);
var
LoopCount: integer;
begin
LoopCount := 0;
// 使用原子操作循环判断写锁是否能进入
while AtomicCmpExchange(Bucket^.ReadWriteLock, Const_WritingFlag,
Const_CanReadWriteFlag) <> Const_CanReadWriteFlag do
begin
inc(LoopCount);
if LoopCount >= Const_LoopCount then
begin
sleep(1);
LoopCount := 0;
end;
end;
end;
// 退出写锁
procedure TLockFreeHash<T>.EndWrite(var Bucket: PHashItem);
begin
// 写完了,就把写标志设置为未写锁
AtomicExchange(Bucket^.ReadWriteLock, Const_CanReadWriteFlag);
end;
end.
三、调用方法
1、使用的单元
uses uLockFreeHash,uLockFreeHashInterface;
2、申明和调用者中实例化Hash删除事件
FWebPathHash: TLockFreeHash<PWebPathInfo>;
// HASH表删除元素事件
procedure OnWebPathDeletionEvent(var Value: PWebPathInfo);
//HASH表删除元素事件
procedure TXXXX.OnWebPathDeletionEvent(var Value: PWebPathInfo);
begin
//这里写Value内各对象释放过程
//然后再释放指针
dispose(Value);end;
3、创建并初始化Hash
FWebPathHash:= TLockFreeHash<TWebPathInfo>.CreateHash(nil);
FWebPathHash.DoDeletion := OnWebPathDeletionEvent;
//先在HASH表存入数据
var
Value:PWebPathInfo;
const
WebPath='/WebBusiness/Login/';//这里只是方便举例
begin
for i:=0 to XXX do begin
new(Value);
Value^.Plugin:=XXXXXX;
FWebPathHash.Add(WebPath.GetHashCode, Value);
end;
end;
4、调用
var
Bucket:PBucket;
const
WebPath='/WebBusiness/Login/';//这里只是方便举例
beginBucket := FWebPathHash.GetValue(WebPath.GetHashCode);
if Bucket <>nil then begin
try
//这里就是你要读取内容的过程
finally
FWebPathHash.SetValue(Bucket);//用完返还指针,使读锁计数器减一
end;
end;
end;
5、修改值
function TXXXX.ModifyValue(var WebPath:string;var Value:PWebPathInfo):boolean;
begin
result:=FWebPathHash.Modify(WebPath.GetHashCode,Value);//返回为false,就表示在Hash中没有该路径,可能已经被删除了。
end;
QQ群:DELPHI开发者群:733975324