Delphi 高效读写锁

// 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.