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