* Initial TSpinLock implementation

packages/fcl-base/examples/README.txt

@@ -81,4 +81,5 @@ csvbom.pp    Test/Demo for BOM detection in CSV document. (needs databom.txt)
 testappexit.pp Test/Demo for TApplication exit code handling. (ExitCode and ExceptionExitcode)
 demoio.pp    Demo for AssignStream from streamio unit.
 testthreadpool  Demo for fpthreadpool unit.
-demolg       TLockGuard demo.
+demolg       TLockGuard demo.
+demo_spinlock TSpinLock demo.

packages/fcl-base/examples/demo_spinlock.pp

@@ -0,0 +1,250 @@
+program demo_spinlock;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}cthreads,{$ENDIF}
+  Classes, SysUtils, syncobjs, dateutils;
+
+const
+  THREAD_COUNT = 10;
+  INCREMENTS_PER_THREAD = 1000000; // We're supposed to go fast, so lots of increments :-)
+
+{
+  Results on my i9 machine, 24 cores: 
+  Linux: spinlock is ~4 times faster than criticalsection
+  Windows: spinlock is ~10 times faster than criticalsection
+}
+
+var
+  MySpinLock: TSpinLock;
+  CS: TCriticalSection;
+  Counter: Integer;
+  
+type
+  TSpinLockThread = class(TThread)
+    procedure Execute; override;
+  end;
+
+  TSpinLockRelaxedThread = class(TThread)
+    procedure Execute; override;
+  end;
+
+  TCriticalSectionThread = class(TThread)
+    procedure Execute; override;
+  end;
+
+procedure TSpinLockThread.Execute;
+var
+  I: Integer;
+begin
+  for I:=1 to INCREMENTS_PER_THREAD do
+    begin
+    MySpinLock.Enter;
+    try
+      Inc(Counter);
+    finally
+      MySpinLock.Exit;
+    end;
+    end;
+end;
+
+procedure TSpinLockRelaxedThread.Execute;
+var
+  I: Integer;
+begin
+  for I:=1 to INCREMENTS_PER_THREAD do
+    begin
+    MySpinLock.Enter;
+    try
+      Inc(Counter);
+    finally
+      MySpinLock.Exit(False);
+    end;
+    end;
+end;
+
+procedure TCriticalSectionThread.Execute;
+var
+  I: Integer;
+begin
+  for I:=1 to INCREMENTS_PER_THREAD do
+    begin
+    CS.Enter;
+    try
+      Inc(Counter);
+    finally
+      CS.Leave;
+    end;
+    end;
+end;
+
+function RunSpinLockBenchmark: Int64;
+var
+  Threads: array of TSpinLockThread;
+  I: Integer;
+  StartTime, EndTime: TDateTime;
+begin
+  WriteLn('--- Testing TSpinLock Performance (PublishNow=True) ---');
+  MySpinLock:=TSpinLock.Create(False);
+  Counter:=0;
+  SetLength(Threads, THREAD_COUNT);
+
+  WriteLn('Starting ', THREAD_COUNT, ' threads, ', INCREMENTS_PER_THREAD, ' ops each.');
+  StartTime:=Now;
+
+  for I:=0 to THREAD_COUNT - 1 do
+    begin
+    Threads[I]:=TSpinLockThread.Create(True);
+    Threads[I].FreeOnTerminate:=False;
+    Threads[I].Start;
+    end;
+
+  for I:=0 to THREAD_COUNT - 1 do
+    begin
+    Threads[I].WaitFor;
+    Threads[I].Free;
+    end;
+
+  EndTime:=Now;
+  Result:=MilliSecondsBetween(EndTime, StartTime);
+  WriteLn('TSpinLock (Strict) Time: ', Result, ' ms');
+  WriteLn('Counter: ', Counter);
+  WriteLn;
+end;
+
+function RunSpinLockRelaxedBenchmark: Int64;
+var
+  Threads: array of TSpinLockRelaxedThread;
+  I: Integer;
+  StartTime, EndTime: TDateTime;
+begin
+  WriteLn('--- Testing TSpinLock Performance (PublishNow=False) ---');
+  MySpinLock:=TSpinLock.Create(False);
+  Counter:=0;
+  SetLength(Threads, THREAD_COUNT);
+
+  WriteLn('Starting ', THREAD_COUNT, ' threads, ', INCREMENTS_PER_THREAD, ' ops each.');
+  StartTime:=Now;
+
+  for I:=0 to THREAD_COUNT - 1 do
+    begin
+    Threads[I]:=TSpinLockRelaxedThread.Create(True);
+    Threads[I].FreeOnTerminate:=False;
+    Threads[I].Start;
+    end;
+
+  for I:=0 to THREAD_COUNT - 1 do
+    begin
+    Threads[I].WaitFor;
+    Threads[I].Free;
+    end;
+
+  EndTime:=Now;
+  Result:=MilliSecondsBetween(EndTime, StartTime);
+  WriteLn('TSpinLock (Relaxed) Time: ', Result, ' ms');
+  WriteLn('Counter: ', Counter);
+  WriteLn;
+end;
+
+function RunCSBenchmark: Int64;
+var
+  Threads: array of TCriticalSectionThread;
+  I: Integer;
+  StartTime, EndTime: TDateTime;
+begin
+  WriteLn('--- Testing TCriticalSection Performance ---');
+  CS:=TCriticalSection.Create;
+  Counter:=0;
+  SetLength(Threads, THREAD_COUNT);
+
+  WriteLn('Starting ', THREAD_COUNT, ' threads, ', INCREMENTS_PER_THREAD, ' ops each.');
+  StartTime:=Now;
+
+  for I:=0 to THREAD_COUNT - 1 do
+    begin
+    Threads[I]:=TCriticalSectionThread.Create(True);
+    Threads[I].FreeOnTerminate:=False;
+    Threads[I].Start;
+    end;
+
+  for I:=0 to THREAD_COUNT - 1 do
+    begin
+    Threads[I].WaitFor;
+    Threads[I].Free;
+    end;
+
+  EndTime:=Now;
+  CS.Free;
+  Result:=MilliSecondsBetween(EndTime, StartTime);
+  WriteLn('TCriticalSection Time: ', Result, ' ms');
+  WriteLn('Counter: ', Counter);
+  WriteLn;
+end;
+
+procedure TestRecursion;
+begin
+  WriteLn('--- Testing Recursion (Thread Tracking) ---');
+  MySpinLock:=TSpinLock.Create(True);
+  WriteLn('Entering first time...');
+  MySpinLock.Enter;
+  try
+    WriteLn('Entering second time (recursive)...');
+    MySpinLock.Enter;
+    try
+      WriteLn('Inside recursive lock.');
+    finally
+      MySpinLock.Exit;
+    end;
+    WriteLn('Exited once.');
+  finally
+    MySpinLock.Exit;
+  end;
+  WriteLn('Exited twice. Success.');
+  WriteLn;
+end;
+
+procedure TestTryEnter;
+begin
+  WriteLn('--- Testing TryEnter ---');
+  MySpinLock:=TSpinLock.Create(False);
+  if MySpinLock.TryEnter then
+    begin
+    WriteLn('Acquired lock with TryEnter.');
+    if not MySpinLock.TryEnter then
+      WriteLn('Correctly failed to acquire already held lock with TryEnter.')
+    else
+      WriteLn('FAILURE: Acquired already held lock without tracking!');
+    MySpinLock.Exit;
+    end
+  else
+    WriteLn('FAILURE: Could not acquire free lock with TryEnter.');
+  WriteLn;
+end;
+
+var
+  SpinTime, SpinRelaxedTime, CSTime: Int64;
+begin
+  try
+    TestRecursion;
+    TestTryEnter;
+    
+    SpinTime:=RunSpinLockBenchmark;
+    SpinRelaxedTime:=RunSpinLockRelaxedBenchmark;
+    CSTime:=RunCSBenchmark;
+
+    WriteLn('--- Results ---');
+    WriteLn('TSpinLock (Strict):  ', SpinTime, ' ms');
+    WriteLn('TSpinLock (Relaxed): ', SpinRelaxedTime, ' ms');
+    WriteLn('TCriticalSection:    ', CSTime, ' ms');
+    
+    if SpinRelaxedTime < SpinTime then
+      WriteLn('Relaxed SpinLock was faster by ', SpinTime - SpinRelaxedTime, ' ms')
+    else
+      WriteLn('Relaxed SpinLock was slower/equal (Difference: ', SpinTime - SpinRelaxedTime, ' ms)');
+
+  except
+    on E: Exception do
+      WriteLn('Test failed with exception: ', E.ClassName, ': ', E.Message);
+  end;
+end.

packages/fcl-base/src/syncobjs.pp

@@ -261,6 +261,35 @@ type
     property Count: Integer read FCount;
     property NextSpinCycleWillYield: Boolean read GetNextSpinCycleWillYield;
   end;
+  
+  // Fast lock, to be used only when lock is held for short times: uses the spinner.
+Type
+  { TSpinLock }
+
+  TSpinLock = record
+  private
+    FLock: LongInt;
+    FOwningThread: TThreadID;
+    FRecursionCount: Integer;
+    FThreadTracking: Boolean;
+    function GetIsLocked: Boolean; inline;
+    function GetIsLockedByCurrentThread: Boolean;
+    function GetIsThreadTrackingEnabled: Boolean; inline;
+    function GetIsOwnedByCurrentThread: Boolean; inline;
+  public
+    constructor Create(EnableThreadTracking: Boolean);
+    procedure Enter; inline;
+    procedure Exit(PublishNow: Boolean = True); inline;
+    function TryEnter: Boolean; overload; inline;
+    function TryEnter(Timeout: Cardinal): Boolean; overload; inline;
+    function TryEnter(const Timeout: TTimeSpan): Boolean; overload; inline;
+
+    property IsLocked: Boolean read GetIsLocked;
+    property IsOwnedByCurrentThread: Boolean read GetIsOwnedByCurrentThread;
+    property IsLockedByCurrentThread: Boolean read GetIsLockedByCurrentThread;
+    property IsThreadTrackingEnabled: Boolean read GetIsThreadTrackingEnabled;
+  end;
+
 
   // Guardian pattern. Use to see if an object was freed or not by adding a guardian instance to it.
 
@@ -1222,6 +1251,154 @@ begin
   until (lElapsedTime >= lWaitTime) or lWait.NextSpinCycleWillYield;
 end;
 
+{ ---------------------------------------------------------------------
+  TSpinLock
+  ---------------------------------------------------------------------}
+
+
+function TSpinLock.GetIsLocked: Boolean;
+
+begin
+  Result:=FLock <> 0;
+end;
+
+
+function TSpinLock.GetIsThreadTrackingEnabled: Boolean; 
+
+begin
+  Result:=FThreadTracking;
+end;
+
+
+function TSpinLock.GetIsOwnedByCurrentThread: Boolean;
+
+begin
+  Result:=(FOwningThread = GetCurrentThreadId);
+end;
+
+
+function TSpinLock.GetIsLockedByCurrentThread: Boolean;
+
+begin
+  Result:=GetIsThreadTrackingEnabled and GetIsLocked and GetIsOwnedByCurrentThread
+end;
+
+
+constructor TSpinLock.Create(EnableThreadTracking: Boolean);
+ 
+begin
+  FLock:=0;
+  FOwningThread:=0;
+  FRecursionCount:=0;
+  FThreadTracking:=EnableThreadTracking;
+end;
+
+
+procedure TSpinLock.Enter;
+
+var
+  Spinner: TSpinWait;
+  CT: TThreadID;
+  
+begin
+  if FThreadTracking then
+    begin
+    CT:=GetCurrentThreadId;
+    if (FOwningThread=CT) then
+      begin
+      Inc(FRecursionCount);
+      System.Exit;
+      end;
+    end;
+
+  Spinner.Reset;
+  while TInterlocked.CompareExchange(FLock,1,0)<>0 do
+    Spinner.SpinCycle;
+
+  if FThreadTracking then
+    begin
+    FOwningThread:=GetCurrentThreadId;
+    FRecursionCount:=1;
+    end;
+end;
+
+
+procedure TSpinLock.Exit(PublishNow: Boolean);
+
+var
+  CT: TThreadID;
+
+begin
+  if FThreadTracking then
+    begin
+    CT:=GetCurrentThreadId;
+    if (FOwningThread<>CT) then
+      raise ELockException.Create('Thread does not own the lock');
+    
+    Dec(FRecursionCount);
+    if (FRecursionCount>0) then 
+      System.Exit;
+    FOwningThread:=TThreadID(0);
+    end;
+  
+  if PublishNow then
+    TInterlocked.Exchange(FLock, 0)
+  else
+    begin
+    // Not 100% sure about this one ?
+    ReadWriteBarrier;
+    FLock:=0;
+    end;
+end;
+
+
+function TSpinLock.TryEnter: Boolean;
+
+begin
+  if FThreadTracking and IsOwnedByCurrentThread then
+    begin
+    Inc(FRecursionCount);
+    System.Exit(True);
+    end;
+
+  Result:=TInterlocked.CompareExchange(FLock,1,0)=0;
+  
+  if Result and FThreadTracking then
+  begin
+    FOwningThread:=GetCurrentThreadId;
+    FRecursionCount:=1;
+  end;
+end;
+
+function TSpinLock.TryEnter(const Timeout: TTimeSpan): Boolean;
+var
+  LSpinner: TSpinWait;
+  LStart: QWord;
+  LTotalMs: QWord;
+begin
+  if TryEnter then 
+    System.Exit(True);
+
+  LTotalMs:=Round(Timeout.TotalMilliseconds);
+  LStart:=GetTickCount64;
+  LSpinner.Reset;
+
+  while (GetTickCount64-LStart)<LTotalMs do
+    begin
+    LSpinner.SpinCycle;
+    if TryEnter then 
+      System.Exit(True);
+    end;
+  Result:=False;
+end;
+
+
+function TSpinLock.TryEnter(Timeout: Cardinal): Boolean;
+
+begin
+  Result:=TryEnter(TTimeSpan.FromMilliseconds(Timeout));
+end;
+
 { ---------------------------------------------------------------------
   TGuardian
   ---------------------------------------------------------------------}