手搓了个读写锁...囧

业务需求, 适合需要使用读写锁进行控制, 印象里delphi一直都没有读写锁, 网上搜了搜也都是自己实现的

所以就手搓了一个, 搓完才发现, 系统自带了跨平台的高效读写锁 TLightweightMREW

留档存个念想吧.....附测试代码

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, System.SyncObjs,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

{$DEFINE SYS_RWLOCK}

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

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
  private
    { Private declarations }
    FLock: {$IFDEF SYS_RWLOCK}TLightweightMREW{$ELSE}TReadWriteLocker{$ENDIF};
    FStop: Boolean;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TReadWriteLocker }

procedure TReadWriteLocker.LockRead;
var
  lCurLock: Integer;
  lWait: TSpinWait;
begin
  {如果有同线程的写锁未释放, 会导致死锁}
  if TThread.Current.ThreadID = FWriteThreadID then
    raise Exception.Create('当前线程有未释放的写锁');

  lWait.Reset;
  while True do
  begin
    lCurLock := FLocker;

    {没有写锁时, 累加读锁}
    if lCurLock <= $FFFF then
    begin
      if TInterlocked.CompareExchange(FLocker, lCurLock + 1, lCurLock) = lCurLock then
        Exit;
    end;
    lWait.SpinCycle;
  end;
end;

procedure TReadWriteLocker.LockWrite;
var
  lWait: TSpinWait;
  lCurrTID: TThreadID;
begin
  lCurrTID := TThread.Current.ThreadID;
  lWait.Reset;

  {只有同线程才能累加写锁数量, 非同线程只通过锁进行互斥
  而同线程不会出现并发, 所以无论是否有写锁存在, 异步线程一定会进入循环判断
  所以先上锁后记录写锁线程, 不会引发冲突}
  if FWriteThreadID <> lCurrTID then
  begin
    while TInterlocked.CompareExchange(FLocker, $10000, 0) <> 0 do
      lWait.SpinCycle;
    FWriteThreadID := lCurrTID;
  end
  else
  begin
    {同线程的写锁, 一定不会出现并发, 所以无需原子操作}
    if FLocker and $FFFF0000 = $FFFF then
      raise Exception.Create('写锁超出上限');
    FLocker := FLocker + $10000;
  end;
end;

function TReadWriteLocker.TryLockRead: Boolean;
var
  lCurLock: Integer;
begin
  Result := False;

  {如果有同线程的写锁未释放, 会导致死锁}
  if TThread.Current.ThreadID = FWriteThreadID then
    Exit;

  lCurLock := FLocker;

  {没有写锁时, 累加读锁}
  if lCurLock > $FFFF then
    Exit;

  Result := TInterlocked.CompareExchange(FLocker, lCurLock + 1, lCurLock) = lCurLock;
end;

function TReadWriteLocker.TryLockWrite: Boolean;
var
  lCurrTID: TThreadID;
begin
  Result := False;

  lCurrTID := TThread.Current.ThreadID;

  if FWriteThreadID <> lCurrTID then
  begin
    Result := TInterlocked.CompareExchange(FLocker, $10000, 0) = 0;
    if Result then
      FWriteThreadID := lCurrTID;
  end
  else
  begin
    if FLocker and $FFFF0000 = $FFFF then
      raise Exception.Create('写锁超出上限');
    FLocker := FLocker + $10000;
    Result := True;
  end;
end;

procedure TReadWriteLocker.UnLockWrite;
var
  lCurrTID: TThreadID;
begin
  lCurrTID := TThread.Current.ThreadID;
  if FWriteThreadID <> lCurrTID then
    raise Exception.Create('写锁不属于当前线程');

  if FLocker < $10000 then
    raise Exception.Create('未进入写锁');

  {最后一次解锁, 将写线程ID归0, 由于写锁全互斥, 所以无需考虑并发}
  if FLocker and $FFFF0000 = $10000 then
    FWriteThreadID := 0;

  FLocker := FLocker - $10000;
end;

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

constructor TReadWriteLocker.Create;
begin
  FLocker := 0;
  FWriteThreadID := 0;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  FLock.{$IFDEF SYS_RWLOCK}BeginWrite{$ELSE}LockWrite{$ENDIF};
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  FLock.{$IFDEF SYS_RWLOCK}BeginRead{$ELSE}LockRead{$ENDIF};
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  FLock.{$IFDEF SYS_RWLOCK}EndWrite{$ELSE}UnLockWrite{$ENDIF};
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  FLock.{$IFDEF SYS_RWLOCK}EndRead{$ELSE}UnLockRead{$ENDIF};
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  TThread.CreateAnonymousThread(
    procedure
    var
      lD: TDateTime;
    begin
      lD := Now;
      FLock.{$IFDEF SYS_RWLOCK}BeginRead{$ELSE}LockRead{$ENDIF};
      try
        MessageBox(0, PChar('read - ' + FormatDateTime('nn:ss.zzz', lD)), '', mb_ok);
      finally
        FLock.{$IFDEF SYS_RWLOCK}EndRead{$ELSE}UnLockRead{$ENDIF};
      end;
    end
  ).Start;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
  TThread.CreateAnonymousThread(
    procedure
    var
      lD: TDateTime;
    begin
      lD := Now;
      FLock.{$IFDEF SYS_RWLOCK}BeginWrite{$ELSE}LockWrite{$ENDIF};
      try
//        if FLock.{$IFDEF SYS_RWLOCK}TryBeginWrite{$ELSE}TryLockWrite{$ENDIF} then
        begin
          MessageBox(0, PChar('write - ' + FormatDateTime('nn:ss.zzz', lD)), '', mb_ok);
//          FLock.{$IFDEF SYS_RWLOCK}EndWrite{$ELSE}UnLockWrite{$ENDIF};
        end;
      finally
        FLock.{$IFDEF SYS_RWLOCK}EndWrite{$ELSE}UnLockWrite{$ENDIF};
      end;
    end
  ).Start;
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
  FStop := False;
  TThread.CreateAnonymousThread(
    procedure
    begin
      while not FStop do
      begin
        Sleep(1);
        if not FLock.{$IFDEF SYS_RWLOCK}TryBeginRead{$ELSE}TryLockRead{$ENDIF} then
          Continue;
        Sleep(1);
        FLock.{$IFDEF SYS_RWLOCK}EndRead{$ELSE}UnLockRead{$ENDIF};
      end;
    end
  ).Start;
end;

procedure TForm1.Button8Click(Sender: TObject);
begin
  FStop := True;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  {$IFNDEF SYS_RWLOCK}FLock := TReadWriteLocker.Create{$ENDIF};
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  {$IFNDEF SYS_RWLOCK}FLock.Free{$ENDIF};
end;

end.