// HeZiHang@cnblogs
// 跨平台简易高效锁

unit utLocker;

interface

type
  // 多读单写锁
  // 1.写的时候阻塞其他所有写和读
  // 2.读的时候不阻塞其他读，但阻塞所有写，当阻塞了一个或以上的写后，将阻塞所有后来新的读
  TMultiReadSingleWriteLocker = class
  protected
    [Volatile]
    FLocker: Integer;
  public
    procedure LockRead;
    procedure UnLockRead; inline;
    procedure LockWrite;
    procedure UnLockWrite; inline;
    function TryLockRead: Boolean; inline;
    function TryLockWrite: Boolean; inline;
    constructor Create;
  end;

  TSimpleLocker = class
  protected
    [Volatile]
    FLocker: Integer;
  public
    procedure Lock;
    procedure UnLock; inline;
    function TryLock: Boolean; inline;
  end;

implementation

uses System.SyncObjs, System.SysUtils, System.Classes;

type
  TSpinWait = record
  private const
    YieldThreshold = 10;
    Sleep1Threshold = 20;
    Sleep0Threshold = 5;
  private
    FCount: Integer;
    function GetNextSpinCycleWillYield: Boolean; inline;
  public
    procedure Reset;inline;
    procedure SpinCycle;inline;

    property Count: Integer read FCount;
    property NextSpinCycleWillYield: Boolean read GetNextSpinCycleWillYield;
  end;

  { TSpinWait }

function TSpinWait.GetNextSpinCycleWillYield: Boolean;
begin
  Result := (FCount > YieldThreshold) or (CPUCount = 1);
end;

procedure TSpinWait.Reset;
begin
  FCount := 0;
end;

procedure TSpinWait.SpinCycle;
var
  SpinCount: Integer;
begin
  if NextSpinCycleWillYield then
  begin
    if FCount >= YieldThreshold then
      SpinCount := FCount - YieldThreshold
    else
      SpinCount := FCount;
    if SpinCount mod Sleep1Threshold = Sleep1Threshold - 1 then
      TThread.Sleep(1)
    else if SpinCount mod Sleep0Threshold = Sleep0Threshold - 1 then
      TThread.Sleep(0)
    else
      TThread.Yield;
  end
  else
    TThread.SpinWait(4 shl FCount);
  Inc(FCount);
  if FCount < 0 then
    FCount := YieldThreshold + 1;
end;

{ TMultiReadSingleWriteLocker }

procedure TMultiReadSingleWriteLocker.LockRead;
var
  CurLock: Integer;
  Wait: TSpinWait;
begin
  Wait.Reset;
  while True do
  begin
    CurLock := FLocker;
    if CurLock <= $FFFF then
    begin
      if TInterlocked.CompareExchange(FLocker, CurLock + 1, CurLock) = CurLock
      then
        Exit;
    end;
    Wait.SpinCycle;
  end;
end;

procedure TMultiReadSingleWriteLocker.LockWrite;
var
  CurLock: Integer;
  Wait: TSpinWait;
begin
  Wait.Reset;
  while True do
  begin
    CurLock := FLocker;
    if CurLock <= $FFFF then
    begin
      if TInterlocked.CompareExchange(FLocker, CurLock + $10000, CurLock) = CurLock
      then
        Exit;
    end;
    Wait.SpinCycle;
  end;
end;

function TMultiReadSingleWriteLocker.TryLockRead: Boolean;
var
  CurLock: Integer;
begin
  CurLock := FLocker;
  if CurLock <= $FFFF then
    Result := TInterlocked.CompareExchange(FLocker, CurLock + 1, CurLock)
      = CurLock
  else
    Result := False;
end;

function TMultiReadSingleWriteLocker.TryLockWrite: Boolean;
var
  CurLock: Integer;
begin
  CurLock := FLocker;
  if CurLock <= $FFFF then
    Result := TInterlocked.CompareExchange(FLocker, CurLock + $10000, CurLock)
      = CurLock
  else
    Result := False;
end;

procedure TMultiReadSingleWriteLocker.UnLockWrite;
begin
  if FLocker < $10000 then
    raise Exception.Create('TMultiReadSingleWriteLocker Error');

  TInterlocked.Add(FLocker, -$10000);
end;

procedure TMultiReadSingleWriteLocker.UnLockRead;
begin
  TInterlocked.Decrement(FLocker);
end;

constructor TMultiReadSingleWriteLocker.Create;
begin
  FLocker := 0;
end;

{ TSimpleLocker }

procedure TSimpleLocker.Lock;
var
  Wait: TSpinWait;
begin
  Wait.Reset;
  while True do
  begin
    if FLocker = 0 then
    begin
      if TInterlocked.CompareExchange(FLocker, 1, 0) = 0 then
        Exit;
    end;
    Wait.SpinCycle;
  end;
end;

function TSimpleLocker.TryLock: Boolean;
begin
  if FLocker = 0 then
  begin
    Result := TInterlocked.CompareExchange(FLocker, 1, 0) = 0;
  end
  else
    Result := False;
end;

procedure TSimpleLocker.UnLock;
begin
  if TInterlocked.CompareExchange(FLocker, 0, 1) <> 1 then
    raise Exception.Create('TSimpleLocker Error');
end;

end.