utils/uutlSyncObjs.pas

unit uutlSyncObjs;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, syncobjs;

type
  TAutoResetEvent = class(TEvent)
  public
    constructor Create(aInitial: boolean = false);
  end;
  // aliased to stay in LCL naming scheme for TSimpleEvent
  TutlAutoResetEvent = TAutoResetEvent;

  TutlSpinLock = class
  private
    fLock: DWord;
    fLockReused: integer;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Enter;
    procedure Leave;
  end;

  generic IutlLock<T> = interface(IUnknown)
    function LockedObject: T;
  end;

  generic TutlLock<T> = class(TInterfacedObject, specialize IutlLock<T>)
  private
    fLock: TCriticalSection;
    fObject: T;
  public
    function LockedObject: T;
    constructor Create(const aLock: TCriticalSection; const aObject: T);
    destructor Destroy; override;
  end;

implementation

{ TAutoResetEvent }

constructor TAutoResetEvent.Create(aInitial: boolean);
begin
  inherited Create(Nil, false, aInitial, '');
end;

{ TutlSpinLock }

constructor TutlSpinLock.Create;
begin
  inherited Create;
  fLock:= 0;
  fLockReused:= 0;
end;

destructor TutlSpinLock.Destroy;
begin
  Enter;
  inherited Destroy;
end;

procedure TutlSpinLock.Enter;
var
  ti: dword;
begin
  ti:= ThreadID;
  if ti = InterlockedCompareExchange(fLock, ti, ti) then begin
    {
      The lock is already held by this thread. This means it cannot be modified by a concurrent
      operation (assuming Enter/Leave bracket correctly), and we can act non-atomar on other variables.
    }
    inc(fLockReused);
  end else begin
    while InterlockedCompareExchange(fLock, ti, 0) <> 0 do ;
  end;
end;

procedure TutlSpinLock.Leave;
var
  ti: DWord;
begin
  ti:= ThreadID;
  // Unlock only if we hold the lock
  if ti = InterlockedCompareExchange(fLock, ti, ti) then begin
    // our lock, but we haven't yet done anything (note the above is essentially a threadsafe CMP if successful)
    if fLockReused = 0 then
      InterLockedExchange(fLock, 0)          // normal lock
    else
      dec(fLockReused);                      // nested locks
  end;
end;

function TutlLock.LockedObject: T;
begin
  result := fObject;
end;

constructor TutlLock.Create(const aLock: TCriticalSection; const aObject: T);
begin
  inherited Create;
  if not Assigned(aLock) then
    raise EArgumentNilException.Create('aLock');
  fLock   := aLock;
  fLock.Enter;
  fObject := aObject;
end;

destructor TutlLock.Destroy;
begin
  fLock.Leave;
  inherited Destroy;
end;

end.