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

阿呆_ 2009-11-03 08:20:28

加精

使用起来极其简单, 任何初始值为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.