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; 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; end.