本人设计了一个高效读写锁，可实现多个线程读一个线程写的锁，应该比Delphi自带的读写锁高效，本人没有做对比测试。
本文的锁不可以在一个线程里重入，否则会锁死，另外读写锁最多支持65535个线程同时读。
// 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.