可用于进程间共享的超小型多读单写锁

  使用起来极其简单, 任何初始值为0的Integer变量都可以作为锁变量, 通过BeginRead(), EndRead(), BeginWrite(), EndWrite()来同步共享资源的读写操作, 如果作为锁变量的Integer位于进程间的共享内存(比如FileMapping)中, 那么就可以实现进程间访问共享数据的同步. 功能和微软的SRW(Slim Reader/Writer) Locks相似, 不过比它强的是支持任意锁嵌套.  

需要注意的一点: 读锁升级写锁过程中数据可能被其它先一步加写锁成功的线程修改, 即BeginRead()后, 调用BeginWrite()前和调用BeginWrite()后数据可能已经发生变化.  

源码如下:

   
   

    
    
    
    
unit uSimplestRWLock;

interface

uses
  Windows, SysUtils;

  procedure BeginRead(var iLock: Integer);
  procedure EndRead(var iLock: Integer);
  procedure BeginWrite(var iLock: Integer);
  procedure EndWrite(var iLock: Integer);

implementation

type
  PThrdLckInfo = ^TThrdLckInfo;
  TThrdLckInfo = record
    Ident: Pointer;
    iRCnt: Integer;
    iWCnt: Integer;
    Prev, Next: PThrdLckInfo;
  end;

threadvar
  iInfo: PThrdLckInfo;

{ Coz InterlockedCompareExchange differs in d7 and d200x, define ourselves here }
function InterlockedCompareExchange(var Destination: Integer; Exchange: Integer; Comperand: Integer): Integer stdcall; external kernel32 name 'InterlockedCompareExchange';

function GetLckInfo(p: Pointer): PThrdLckInfo;
begin
  Result := iInfo;
  while (Result <> nil) and (Result.Ident <> p) do
    Result := Result.Next;
  if Result = nil then
  begin
    Result := PThrdLckInfo(AllocMem(sizeof(TThrdLckInfo)));
    Result.Next := iInfo;
    iInfo := Result;
    Result.Ident := p;
  end;
end;

procedure FreeInfo(p: PThrdLckInfo);
begin
  if p.Prev <> nil then p.Prev.Next := p.Next;
  if p.Next <> nil then p.Next.Prev := p.Prev;
  if iInfo = p then iInfo := p.Next;
  FreeMem(p);
end;

const
  MAX_LIGHTWEIGHT_SWITCH = 5;
  MAX_MEDIUMWEIGHT_SWITCH = 10;
  HEAVYWEIGHT_SWITCH_INTERVAL = 50;

procedure SwitchOut(var Cnt: Integer);  // wait function
begin
  if Cnt < MAX_LIGHTWEIGHT_SWITCH then
  begin
    Inc(Cnt);
    if SwitchToThread then
      Exit;
  end;
  if Cnt < MAX_MEDIUMWEIGHT_SWITCH then
  begin
    Inc(Cnt);
    Sleep(1);
    Exit;
  end;
  Cnt := 0;
  WaitForSingleObject(GetCurrentThread, HEAVYWEIGHT_SWITCH_INTERVAL);
end;

procedure BeginRead(var iLock: Integer);  // iLock = 0: none lock
                                          //       > 0: someone has locked for writing
                                          //       < 0: someone has locked for reading
var
  n, c: Integer;
  p: PThrdLckInfo;
begin
  p := GetLckInfo(@iLock);
  if p.iRCnt < 0 then      // recursively reader lock
    Dec(p.iRCnt)
  else if p.iWCnt > 0 then  // writer lock already applied
  begin
    InterlockedDecrement(iLock);
    Dec(p.iRCnt);
  end
  else begin     // try to lock for reading, if iLock <= 0 then can be locked
                 // otherwise must wait for writer-lock to unlock
    c := 0;
    repeat
      n := InterlockedCompareExchange(iLock, 0, 0);
      if (n > 0) then        // other thread has locked for writing
      begin
        SwitchOut(c);        // wait
        Continue;
      end;
    until InterlockedCompareExchange(iLock, n-1, n) = n; // iLock := iLock-1 if succeeded
    Dec(p.iRCnt);
  end;
end;

procedure EndRead(var iLock: Integer);
var
  p: PThrdLckInfo;
begin
  p :=GetLckInfo(@iLock);
  if InterlockedIncrement(p.iRCnt) = 0 then // current thread's last reader lock
  begin
    InterlockedIncrement(iLock);
    SwitchToThread;      // give other waiting threads a chance to acquire their locks
  end;
  if (p.iRCnt = 0) and (p.iWCnt = 0) then
    FreeInfo(p);
end;

procedure BeginWrite(var iLock: Integer);
var
  n, v, c: Integer;
  p: PThrdLckInfo;
begin
  p := GetLckInfo(@iLock);
  c := 0;
  if p.iWCnt > 0 then    // already locked for writing
    Inc(p.iWCnt)
  else begin
    v := GetCurrentThreadId shl 1;
    if p.iRCnt < 0 then             // has previous reader lock
    begin
      InterlockedIncrement(iLock);  // temporarily unlock reader
      Dec(v);
    end;
    repeat
      n := InterlockedCompareExchange(iLock, v, 0);  // succeed only none has locked
      if n <> 0 then
        SwitchOut(c);
    until n = 0;
    Inc(p.iWCnt);
  end;
end;

procedure EndWrite(var iLock: Integer);
var
  n, v: Integer;
  p: PThrdLckInfo;
begin
  p := GetLckInfo(@iLock);
  if InterlockedDecrement(p.iWCnt) = 0 then  // current thread's last writer lock
  begin
    v := GetCurrentThreadId shl 1;
    repeat
      n := iLock;
    until InterlockedCompareExchange(iLock, n-v, n) = n; // if succeeded, iLock is 0 (none lock)
                                                         // or -1 (it's an upgraded writer lock,
                                                         // reader lock still exists)
    if (p.iRCnt = 0) and (p.iWCnt = 0) then
      FreeInfo(p);
    SwitchToThread;
  end;
end;

end.