{ Thread synchronization }

{ TMultiReadExclusiveWriteSynchronizer - реализация на Mutex-ах вместо Delphi-ского

  minimizes thread serialization to gain
  read access to a resource shared among threads while still providing complete
  exclusivity to callers needing write access to the shared resource.
  (multithread shared reads, single thread exclusive write)
  Reading is allowed while owning a write lock.
  Read locks can be promoted to write locks.}

unit MultiReadExclusiveWriteSynchronizer;

interface
  USES Windows, SyncObjs;

type

  TMultiReadExclusiveWriteSynchronizer = class
  private
    prWriteLock: THANDLE; // Блокировка начала новых чтений при запросе BeginWrite
                          // для установки приоритета Write над Read
    prCount:dword; // Размер массивов
    prUsed:dword; // Использующаяся часть массива Mutex-ов
    prMutexArray:array of THANDLE; // массив Mutex-ов
    prThreadArray:array of THANDLE; // массив ThreadID-ов
    prWritePrecedence:boolean; // Приоритет Write над Read
    prAllocated:boolean; // Размещены HANDLEs
  public
    constructor Create; overload;
    constructor Create(aCount:dword); overload;
    destructor Destroy; override;
    procedure BeginRead; overload;
    procedure EndRead;
    procedure BeginWrite; overload;
    procedure EndWrite;
    function BeginRead(aTimeOut:dword):tWaitResult; overload;
    function BeginWrite(aTimeOut:dword):tWaitResult; overload;
    // Максимальное число одновременных Read
    property ConcurrentReads:dword read prCount;
    // Приоритет Write над Read
    property WritePrecedence:boolean read prWritePrecedence write prWritePrecedence;
  end;

implementation
  USES SysUtils;

{ TMultiReadExclusiveWriteSynchronizer }

constructor TMultiReadExclusiveWriteSynchronizer.Create(aCount:dword);
  var i:integer; h:THANDLE;
begin
  inherited Create;
  if aCount=0 then aCount:=4;
  if aCount>MAXIMUM_WAIT_OBJECTS then aCount:=MAXIMUM_WAIT_OBJECTS;
  prWriteLock:=CreateMutex(NIL,FALSE,NIL);
  Win32Check(prWriteLock<>0);
  prCount:=aCount;
  SetLength(prMutexArray, prCount);
  SetLength(prThreadArray, prCount);
  for i:=0 to Pred(prCount) do begin
    h:=CreateMutex(NIL,FALSE,NIL);
    Win32Check(h<>0);
    prMutexArray[i]:=h;
  end;
  prAllocated:=TRUE;
end;

constructor TMultiReadExclusiveWriteSynchronizer.Create;
begin
  Create(MAXIMUM_WAIT_OBJECTS);
end;

destructor TMultiReadExclusiveWriteSynchronizer.Destroy;
  var i:integer;
begin
  WritePrecedence:=TRUE;
  if prAllocated then
    BeginWrite;
  inherited Destroy;
  for i:=0 to Pred(prCount) do begin
    CloseHandle(prMutexArray[i]);
  end;
  CloseHandle(prWriteLock);
end;

procedure TMultiReadExclusiveWriteSynchronizer.BeginWrite;
  var wp:boolean;
begin
  wp:=WritePrecedence;
  if wp then
    WaitForSingleObject(prWriteLock,INFINITE);
  WaitForMultipleObjectsEx(
    prCount,	// number of handles in handle array
    @prMutexArray[0],	// points to the object-handle array
    TRUE,	// wait flag
    INFINITE,	// time-out interval in milliseconds
    FALSE 	// alertable wait flag
   );
  if wp then
    ReleaseMutex(prWriteLock);
end;

function TMultiReadExclusiveWriteSynchronizer.BeginWrite(aTimeOut:dword):tWaitResult;
  var wr:dword; wp:boolean;
begin
  wp:=WritePrecedence;
  if wp then begin
    wr:=WaitForSingleObject(prWriteLock,aTimeOut);
    if (WAIT_TIMEOUT=wr) then begin
      Result:=wrTimeOut;
      Exit;
    end;
  end;
  wr:=WaitForMultipleObjectsEx(
    prCount,	// number of handles in handle array
    @prMutexArray[0],	// points to the object-handle array
    TRUE,	// wait flag
    aTimeOut,	// time-out interval in milliseconds
    FALSE 	// alertable wait flag
   );
  if wp then
    ReleaseMutex(prWriteLock);
  if (WAIT_OBJECT_0<=wr) and (wr<(WAIT_OBJECT_0+prCount)) then begin
    Result:=wrSignaled;
  end else if (WAIT_ABANDONED_0<=wr) and (wr<(WAIT_ABANDONED_0+prCount)) then begin
    Result:=wrAbandoned;
  end else if (WAIT_TIMEOUT=wr) then begin
    Result:=wrTimeOut;
  end;
end;

procedure TMultiReadExclusiveWriteSynchronizer.EndWrite;
  var i:integer;
begin
  for i:=0 to Pred(prCount) do begin
    ReleaseMutex(prMutexArray[i]);
  end;
end;

procedure TMultiReadExclusiveWriteSynchronizer.BeginRead;
var
  wr: dword; wp:boolean;
begin
  wp:=WritePrecedence;
  if wp then begin
    WaitForSingleObject(prWriteLock,INFINITE);
    ReleaseMutex(prWriteLock);
  end;
  wr:=WaitForMultipleObjectsEx(
    prCount,	// number of handles in handle array
    @prMutexArray[0],	// points to the object-handle array
    FALSE,	// wait flag
    INFINITE,	// time-out interval in milliseconds
    FALSE 	// alertable wait flag
   );
   if (WAIT_OBJECT_0<=wr) and (wr<(WAIT_OBJECT_0+prCount)) then begin
     wr:=wr-WAIT_OBJECT_0;
     prThreadArray[wr]:=GetCurrentThreadID;
     if wr>prUsed then
       prUsed:=wr;
   end else if (WAIT_ABANDONED_0<=wr) and (wr<(WAIT_ABANDONED_0+prCount)) then begin
     wr:=wr-WAIT_ABANDONED_0;
     prThreadArray[wr]:=GetCurrentThreadID;
     if wr>prUsed then
       prUsed:=wr;
   end;
end;

function TMultiReadExclusiveWriteSynchronizer.BeginRead(aTimeOut:dword):tWaitResult;
  var wr:dword; wp:boolean;
begin
  wp:=WritePrecedence;
  if wp then begin
    wr:=WaitForSingleObject(prWriteLock,aTimeOut);
    if (WAIT_TIMEOUT=wr) then begin
      Result:=wrTimeOut;
      Exit;
    end;
    ReleaseMutex(prWriteLock);
  end;
  wr:=WaitForMultipleObjectsEx(
    prCount,	// number of handles in handle array
    @prMutexArray[0],	// points to the object-handle array
    FALSE,	// wait flag
    aTimeOut,	// time-out interval in milliseconds
    FALSE 	// alertable wait flag
  );
  if (WAIT_OBJECT_0<=wr) and (wr<(WAIT_OBJECT_0+prCount)) then begin
    wr:=wr-WAIT_OBJECT_0;
    prThreadArray[wr]:=GetCurrentThreadID;
    if wr>prUsed then
      prUsed:=wr;
    Result:=wrSignaled;
  end else if (WAIT_ABANDONED_0<=wr) and (wr<(WAIT_ABANDONED_0+prCount)) then begin
    wr:=wr-WAIT_ABANDONED_0;
    prThreadArray[wr]:=GetCurrentThreadID;
    if wr>prUsed then
      prUsed:=wr;
    Result:=wrAbandoned;
  end else if (WAIT_TIMEOUT=wr) then begin
    Result:=wrTimeOut;
  end;
end;

procedure TMultiReadExclusiveWriteSynchronizer.EndRead;
var
  i, ThreadID: Integer;
begin
  ThreadID:=GetCurrentThreadID;
  for i:=0 to prUsed do begin
    if prThreadArray[i]=ThreadID then begin
      ReleaseMutex(prMutexArray[i]);
    end;
  end;
end;

end.