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

     前面几篇已经介绍的比较清楚了，这里就直接上代码，代码经过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/';//这里只是方便举例

begin

  Bucket := 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